@@ -3,7 +3,6 @@ module Transform.Optimize (optimize) where
3import SourceSyntax.Everything
3import SourceSyntax.Everything
4import Control.Arrow (second, (***))
4import Control.Arrow (second, (***))
5import Data.Char (isAlpha)
5import Data.Char (isAlpha)
6−import Transform.Substitute
8optimize (Module name ims exs stmts) =
7optimize (Module name ims exs stmts) =
9 Module name ims exs (map optimizeStmt stmts)
8 Module name ims exs (map optimizeStmt stmts)
@@ -20,8 +19,7 @@ instance Simplify (Declaration t v) where
20 simp stmt = stmt
19 simp stmt = stmt
22instance Simplify (Def t v) where
21instance Simplify (Def t v) where
23− simp (FnDef func args e) = FnDef func args (simp e)
22+ simp (Def name e) = Def name (simp e)
24− simp (OpDef op a1 a2 e) = OpDef op a1 a2 (simp e)
25 simp x = x
23 simp x = x
27instance Simplify e => Simplify (Located e) where
25instance Simplify e => Simplify (Located e) where
@@ -34,11 +32,7 @@ instance Simplify (Expr t v) where
34 Range e1 e2 -> Range (f e1) (f e2)
32 Range e1 e2 -> Range (f e1) (f e2)
35 Binop op e1 e2 -> binop op (f e1) (f e2)
33 Binop op e1 e2 -> binop op (f e1) (f e2)
36 Lambda x e -> Lambda x (f e)
34 Lambda x e -> Lambda x (f e)
37− Record fs -> Record (map (\(f,as,e) -> (f, as, simp e)) fs)
35+ Record fs -> Record (map (second simp) fs)
38− App (L t s (Lambda x e1)) e2 ->
39− if isValue e2' then subst x e2' e1' else App (L t s (Lambda x ce1')) ce2'
40− where ce1'@(L _ _ e1') = f e1
41− ce2'@(L _ _ e2') = f e2
42 App e1 e2 -> App (f e1) (f e2)
36 App e1 e2 -> App (f e1) (f e2)
43 Let defs e -> Let (map simp defs) (f e)
37 Let defs e -> Let (map simp defs) (f e)
44 Data name es -> Data name (map f es)
38 Data name es -> Data name (map f es)
@@ -133,12 +127,6 @@ binop op ce1@(L t1 s1 e1) ce2@(L t2 s2 e2) =
133 ("++", _, Data "[]" []) -> e1
127 ("++", _, Data "[]" []) -> e1
134 ("++", Data "::" [h,t], _) -> Data "::" [h, none $ binop "++" t ce2]
128 ("++", Data "::" [h,t], _) -> Data "::" [h, none $ binop "++" t ce2]
136− ("|>", _, _) -> App ce2 ce1
137− ("<|", _, _) -> App ce1 ce2
140− App ce1 (none $ App ce2 (none $ Var "x")))
142 _ | isAlpha (head op) || '_' == head op ->
130 _ | isAlpha (head op) || '_' == head op ->
143 App (none $ App (none $ Var op) ce1) ce2
131 App (none $ App (none $ Var op) ce1) ce2
144 | otherwise -> Binop op ce1 ce2
132 | otherwise -> Binop op ce1 ce2