pointless-rewrite 0.0.1 → 0.0.2

raw patch · 7 files changed

+18/−14 lines, 7 files

Files

pointless-rewrite.cabal +1/−1
src/Data/Eval.hs +1/−1
src/Transform/Rewriting.hs +3/−3
src/Transform/Rules/Lenses.hs +1/−0
src/Transform/Rules/PF.hs +4/−1
src/Transform/Rules/PF/Combinators.hs +4/−6
src/Transform/Rules/SYB.hs +4/−2

pointless-rewrite.cabal view

@@ -1,5 +1,5 @@ Name:            pointless-rewrite-Version:         0.0.1+Version:         0.0.2 License:         BSD3 License-file:    LICENSE Author:          Alcino Cunha <alcino@di.uminho.pt>, Hugo Pacheco <hpacheco@di.uminho.pt>

src/Data/Eval.hs view

@@ -70,7 +70,7 @@ eval _ HOLE = error "hole" eval _ TOP = error "top" eval (Fun _ _) (FUN _ f) = f-eval (Lns _ _) (CONV _ f) = error "converse evaluation"+eval (Fun _ _) (CONV _ f) = error "converse evaluation" eval (Lns _ _) (CONV_LNS _ f) = error "converse evaluation" eval (Lns _ _) (LNS _ l) = l eval (Fun c a) (COMPF fctr x f g) = eval (Fun c a) (COMP (rep fctr x) f g)

src/Transform/Rewriting.hs view

@@ -62,8 +62,8 @@     where aux :: MonadPlus m => Int -> Location -> Spine a -> m (Spine a)           aux 0     l (Ap f (a :| y)) = do z <- replace l (b :| x) (a :| y)                                            return $ Ap f (a :| z)-          aux (n+1) l (Ap f (a :| y)) = do g <- aux n l f-                                           return $ Ap g (a :| y)+          aux (n) l (Ap f (a :| y)) = do g <- aux (succ n) l f+                                         return $ Ap g (a :| y)           aux _ _ _ = mzero  hole :: Type a -> a@@ -76,7 +76,7 @@ 	  xua l   (a :| y) = fromSpine $ aux (last l) (init l) (toSpine a y) 	  aux :: Int -> Location -> Spine a -> Spine a           aux 0     l (Ap f (a :| y)) = Ap f (a :| xua l (a :| y))-          aux (n+1) l (Ap f (a :| y)) = Ap (aux n l f) (a :| y)+          aux n l (Ap f (a :| y)) = Ap (aux (succ n) l f) (a :| y)  -- The basic type of rules type GenericM m = forall a . Type a -> Pf a -> m (Pf a)

src/Transform/Rules/Lenses.hs view

@@ -39,6 +39,7 @@ optimise_lns :: Rule optimise_lns = step1     where+    step1, right, rules, prot, undef, prods, sums, bangs, dists, convs, recs, lists, fuse :: Rule     step1 = outermost (top comp_assocr_lns ||| rules) >>> right >>> try (once fuse >>> optimise_lns)     right = many (once (top comp_assocr_lns))     rules = top nat_id_lns ||| prot ||| undef ||| prods ||| sums ||| bangs ||| dists ||| convs ||| lists ||| recs

src/Transform/Rules/PF.hs view

@@ -27,6 +27,7 @@ optimise_pf :: Rule optimise_pf = outermost (top comp_assocr ||| rules) >>> right >>> try (once fuse >>> optimise_pf)     where  +    right, rules, prot, undef, lns, prods, sums, bangs, dists, convs, recs, fuse :: Rule     right = many (once (top comp_assocr))     rules = top nat_id ||| prot ||| undef ||| lns ||| prods ||| sums ||| bangs ||| dists ||| convs ||| recs     prot  = top unprotect@@ -56,8 +57,10 @@         ||| top distl_fusion ||| top distl_nat          {-||| top hylo_id  ||| top cata_fusion ||| top ana_fusion         ||| top hylo_shift-}-        ++beautify_pf :: Rule         beautify_pf = outermost (prods ||| sums)    where+   prods, sums :: Rule    prods = top prod_unfusion ||| top prod_undef    sums = top sum_unfusion ||| top sum_undef

src/Transform/Rules/PF/Combinators.hs view

@@ -309,9 +309,8 @@ prod_unfusion :: Rule prod_unfusion _ (ID `SPLIT` ID) = mzero prod_unfusion t@(Fun a (Prod b c)) w@(f `SPLIT` g) = do-    let r = sum_unfusion ||| rightmost-    COMP x f' h  <- r (Fun a b) f-    COMP y g' h' <- r (Fun a c) g+    COMP x f' h  <- (sum_unfusion ||| rightmost) (Fun a b) f+    COMP y g' h' <- (sum_unfusion ||| rightmost) (Fun a c) g     Eq <- teq x y     guard $ geq (Pf $ Fun a x) h h'     res <- try (comp1 prod_unfusion >>> comp_assocr) t (COMP x (f' /\= g') h)@@ -328,9 +327,8 @@ sum_unfusion :: Rule sum_unfusion _ (ID `EITHER` ID) = mzero sum_unfusion t@(Fun (Either a b) c) w@(f `EITHER` g) = do-    let r = prod_unfusion ||| leftmost-    COMP x h  f' <- r (Fun a c) f-    COMP y h' g' <- r (Fun b c) g+    COMP x h  f' <- (prod_unfusion ||| leftmost) (Fun a c) f+    COMP y h' g' <- (prod_unfusion ||| leftmost) (Fun b c) g     Eq <- teq x y     guard $ geq (Pf $ Fun x c) h h'     res <- try (comp2 sum_unfusion >>> comp_assocl) t (COMP x h (f' \/= g'))

src/Transform/Rules/SYB.hs view

@@ -26,12 +26,14 @@  optimise_tp :: Rule optimise_tp = innermost rules-    where rules = top nop_applyT ||| top seq_applyT+    where rules :: Rule+          rules = top nop_applyT ||| top seq_applyT               ||| top gmapT_applyT ||| top everywhere_applyT               ||| top mkT_applyT ||| top extT_applyT  optimise_tu :: Rule optimise_tu = innermost rules-    where rules = top emptyQ_applyQ ||| top union_applyQ+    where rules :: Rule+          rules = top emptyQ_applyQ ||| top union_applyQ               ||| top gmapQ_applyQ ||| top everything_applyQ               ||| top mkQ_applyQ ||| top extQ_applyQ