git.iko.soy/elk
on master help sign in
Improve optimizations a bit. The compiler now performs beta reduction in some simple cases.
8ac0c81evancz
elm/src/Gen/Cases.hs+1−1
compare with master
unifiedsplit
@@ -45,7 +45,7 @@ match vs cs def
45
45
46matchVar :: [String] -> [([Pattern],Expr)] -> Match -> GuidCounter Match
46matchVar :: [String] -> [([Pattern],Expr)] -> Match -> GuidCounter Match
47matchVar (v:vs) cs def = match vs (map subVar cs) def
47matchVar (v:vs) cs def = match vs (map subVar cs) def
48− where subVar (PVar x : ps, e) = (ps, subst v x e)
48+ where subVar (PVar x : ps, e) = (ps, subst x (Var v) e)
49 subVar (PAnything : ps, e) = (ps, e)
49 subVar (PAnything : ps, e) = (ps, e)
50
50
51matchCon :: [String] -> [([Pattern],Expr)] -> Match -> GuidCounter Match
51matchCon :: [String] -> [([Pattern],Expr)] -> Match -> GuidCounter Match
elm/src/Optimize.hs+14−1
@@ -3,7 +3,7 @@ module Optimize (optimize) where
3import Ast
3import Ast
4import Control.Arrow (second)
4import Control.Arrow (second)
5import Data.Char (isAlpha)
5import Data.Char (isAlpha)
6−
6+import Substitute
7
7
8optimize (Module name ims exs stmts) =
8optimize (Module name ims exs stmts) =
9 Module name ims exs (map optimizeStmt stmts)
9 Module name ims exs (map optimizeStmt stmts)
@@ -21,6 +21,9 @@ simp expr =
21 Range e1 e2 -> Range (f e1) (f e2)
21 Range e1 e2 -> Range (f e1) (f e2)
22 Binop op e1 e2 -> simp_binop op (f e1) (f e2)
22 Binop op e1 e2 -> simp_binop op (f e1) (f e2)
23 Lambda x e -> Lambda x (f e)
23 Lambda x e -> Lambda x (f e)
24+ App (Lambda x e1) e2 ->
25+ if isValue e2' then subst x e2' e1' else App (Lambda x e1') e2'
26+ where { e1' = f e1 ; e2' = f e2 }
24 App e1 e2 -> App (f e1) (f e2)
27 App e1 e2 -> App (f e1) (f e2)
25 If e1 e2 e3 -> simp_if (f e1) (f e2) (f e3)
28 If e1 e2 e3 -> simp_if (f e1) (f e2) (f e3)
26 Let defs e -> Let (map simpDef defs) (f e)
29 Let defs e -> Let (map simpDef defs) (f e)
@@ -32,6 +35,15 @@ simp expr =
32simp_if (Boolean b) e2 e3 = if b then e2 else e3
35simp_if (Boolean b) e2 e3 = if b then e2 else e3
33simp_if a b c = If a b c
36simp_if a b c = If a b c
34
37
38+isValue e = case e of { IntNum _ -> True
39+ ; FloatNum _ -> True
40+ ; Chr _ -> True
41+ ; Str _ -> True
42+ ; Boolean _ -> True
43+ ; Var _ -> True
44+ ; Data _ _ -> True
45+ ; _ -> False }
46+
35simp_binop = binop
47simp_binop = binop
36
48
37binop op (IntNum n) (IntNum m) = f n m
49binop op (IntNum n) (IntNum m) = f n m
@@ -87,6 +99,7 @@ binop "++" e (Data "Nil" []) = e
87binop "++" (Data "Cons" [h,t]) e = Data "Cons" [h, binop "++" t e]
99binop "++" (Data "Cons" [h,t]) e = Data "Cons" [h, binop "++" t e]
88
100
89binop "$" e1 e2 = App e1 e2
101binop "$" e1 e2 = App e1 e2
102+binop "." e1 e2 = Lambda "x" (App e1 (App e2 (Var "x")))
90
103
91binop op e1 e2
104binop op e1 e2
92 | isAlpha (head op) || '_' == head op = App (App (Var op) e1) e2
105 | isAlpha (head op) || '_' == head op = App (App (Var op) e1) e2
elm/src/Substitute.hs+4−4
@@ -4,9 +4,9 @@ import Control.Arrow (second)
4
4
5import Ast
5import Ast
6
6
7−subst :: String -> String -> Expr -> Expr
7+subst :: String -> Expr -> Expr -> Expr
8−subst new old expr =
8+subst old new expr =
9− let f = subst new old in
9+ let f = subst old new in
10 case expr of
10 case expr of
11 Range e1 e2 -> Range (f e1) (f e2)
11 Range e1 e2 -> Range (f e1) (f e2)
12 Access e x -> Access (f e) x
12 Access e x -> Access (f e) x
@@ -20,7 +20,7 @@ subst new old expr =
20 Input _ -> expr
20 Input _ -> expr
21 Let defs e -> Let (map substDef defs) (f e)
21 Let defs e -> Let (map substDef defs) (f e)
22 where substDef (Definition name vs e) = Definition name vs (f e)
22 where substDef (Definition name vs e) = Definition name vs (f e)
23− Var x -> if x == old then Var new else expr
23+ Var x -> if x == old then new else expr
24 Case e cases -> Case (f e) $ map (second f) cases
24 Case e cases -> Case (f e) $ map (second f) cases
25 Data name es -> Data name (map f es)
25 Data name es -> Data name (map f es)
26 _ -> expr
26 _ -> expr