git.iko.soy/elk
on d178521 help sign in
elk/elm/src/Optimize.hs
106 lines 3.9 kB history raw
1module Optimize (optimize) where
3import Ast
4import Control.Arrow (second)
5import Data.Char (isAlpha)
6import Substitute
8optimize (Module name ims exs stmts) =
9 Module name ims exs (map optimizeStmt stmts)
11optimizeStmt stmt = if stmt == stmt' then stmt' else optimizeStmt stmt'
12 where stmt' = simpStmt stmt
13 simpStmt (Def name args e) = Def name args (simp e)
14 simpStmt (ImportEvent js b elm t) = ImportEvent js (simp b) elm t
15 simpStmt stmt = stmt
17simp :: Expr -> Expr
18simp expr =
19 let f = simp in
20 case expr of
21 Range e1 e2 -> Range (f e1) (f e2)
22 Binop op e1 e2 -> simp_binop op (f e1) (f e2)
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 }
27 App e1 e2 -> App (f e1) (f e2)
28 If e1 e2 e3 -> simp_if (f e1) (f e2) (f e3)
29 Let defs e -> Let (map simpDef defs) (f e)
30 where simpDef (Definition func args e) = Definition func args (f e)
31 Data name es -> Data name (map f es)
32 Case e cases -> Case (f e) (map (second f) cases)
33 _ -> expr
35simp_if (Boolean b) e2 e3 = if b then e2 else e3
36simp_if a b c = If a b c
38isValue 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 }
47simp_binop = binop
49binop op (IntNum n) (IntNum m) = f n m
50 where f a b = case op of
51 { "+" -> IntNum $ (+) a b
52 ; "-" -> IntNum $ (-) a b
53 ; "*" -> IntNum $ (*) a b
54 ; "div" -> IntNum $ div a b
55 ; "mod" -> IntNum $ mod a b
56 ; "<" -> Boolean $ a < b
57 ; ">" -> Boolean $ a < b
58 ; "<=" -> Boolean $ a <= b
59 ; ">=" -> Boolean $ a >= b
60 ; "==" -> Boolean $ a == b
61 ; "/=" -> Boolean $ a /= b
62 ; _ -> Binop op (IntNum n) (IntNum m) }
64binop "-" e (IntNum 0) = e
65binop "+" (IntNum 0) e = e
66binop "+" e (IntNum 0) = e
67binop "+" (IntNum n) (Binop "+" (IntNum m) e) = binop "+" (IntNum (n+m)) e
68binop "+" (IntNum n) (Binop "+" e (IntNum m)) = binop "+" (IntNum (n+m)) e
70binop "/" e (IntNum 1) = e
71binop "div" e (IntNum 1) = e
72binop "*" (IntNum 0) e = IntNum 0
73binop "*" (IntNum 1) e = e
74binop "*" (IntNum n) (Binop "*" (IntNum m) e) = binop "*" (IntNum (n*m)) e
75binop "*" (IntNum n) (Binop "*" e (IntNum m)) = binop "*" (IntNum (n*m)) e
77binop "+" e (IntNum n) = binop "+" (IntNum n) e
78binop "*" e (IntNum n) = binop "*" (IntNum n) e
80binop op (Boolean n) (Boolean m) = f n m
81 where f a b = case op of { "&&" -> Boolean $ (&&) n m
82 ; "||" -> Boolean $ (||) n m
83 ; _ -> Binop op (Boolean n) (Boolean m) }
85binop "&&" (Boolean True) e = e
86binop "&&" (Boolean False) e = Boolean False
87binop "||" (Boolean True) e = Boolean True
88binop "||" (Boolean False) e = e
90binop "&&" e (Boolean n) = binop "&&" (Boolean n) e
91binop "||" e (Boolean n) = binop "||" (Boolean n) e
93binop ":" h t = cons h t
94binop "++" (Str s1) (Str s2) = Str $ s1 ++ s2
95binop "++" (Str s1) (Binop "++" (Str s2) e) = Binop "++" (Str $ s1 ++ s2) e
96binop "++" (Binop "++" e (Str s1)) (Str s2) = Binop "++" e (Str $ s1 ++ s2)
97binop "++" (Data "Nil" []) e = e
98binop "++" e (Data "Nil" []) = e
99binop "++" (Data "Cons" [h,t]) e = Data "Cons" [h, binop "++" t e]
101binop "$" e1 e2 = App e1 e2
102binop "." e1 e2 = Lambda "x" (App e1 (App e2 (Var "x")))
104binop op e1 e2
105 | isAlpha (head op) || '_' == head op = App (App (Var op) e1) e2
106 | otherwise = Binop op e1 e2