git.iko.soy/elk
on d15e080 help sign in
elk/elm/src/Optimize.hs
115 lines 4.0 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' = simp stmt
14class Simplify a where
15 simp :: a -> a
17instance Simplify Statement where
18 simp (Definition def) = Definition (simp def)
19 simp (ImportEvent js b elm t) = ImportEvent js (simp b) elm t
20 simp stmt = stmt
22instance Simplify Def where
23 simp (FnDef func args e) = FnDef func args (simp e)
24 simp (OpDef op a1 a2 e) = OpDef op a1 a2 (simp e)
27instance Simplify Expr where
28 simp expr =
29 let f = simp in
30 case expr of
31 Range e1 e2 -> Range (f e1) (f e2)
32 Binop op e1 e2 -> simp_binop op (f e1) (f e2)
33 Lambda x e -> Lambda x (f e)
34 App (Lambda x e1) e2 ->
35 if isValue e2' then subst x e2' e1' else App (Lambda x e1') e2'
36 where { e1' = f e1 ; e2' = f e2 }
37 App e1 e2 -> App (f e1) (f e2)
38 If e1 e2 e3 -> simp_if (f e1) (f e2) (f e3)
39 Let defs e -> Let (map simp defs) (f e)
40 Data name es -> Data name (map f es)
41 Case e cases -> Case (f e) (map (second f) cases)
42 _ -> expr
44simp_if (Boolean b) e2 e3 = if b then e2 else e3
45simp_if a b c = If a b c
47isValue e = case e of { IntNum _ -> True
48 ; FloatNum _ -> True
49 ; Chr _ -> True
50 ; Str _ -> True
51 ; Boolean _ -> True
52 ; Var _ -> True
53 ; Data _ _ -> True
54 ; _ -> False }
56simp_binop = binop
58binop op (IntNum n) (IntNum m) = f n m
59 where f a b = case op of
60 { "+" -> IntNum $ (+) a b
61 ; "-" -> IntNum $ (-) a b
62 ; "*" -> IntNum $ (*) a b
63 ; "div" -> IntNum $ div a b
64 ; "mod" -> IntNum $ mod a b
65 ; "<" -> Boolean $ a < b
66 ; ">" -> Boolean $ a < b
67 ; "<=" -> Boolean $ a <= b
68 ; ">=" -> Boolean $ a >= b
69 ; "==" -> Boolean $ a == b
70 ; "/=" -> Boolean $ a /= b
71 ; _ -> Binop op (IntNum n) (IntNum m) }
73binop "-" e (IntNum 0) = e
74binop "+" (IntNum 0) e = e
75binop "+" e (IntNum 0) = e
76binop "+" (IntNum n) (Binop "+" (IntNum m) e) = binop "+" (IntNum (n+m)) e
77binop "+" (IntNum n) (Binop "+" e (IntNum m)) = binop "+" (IntNum (n+m)) e
79binop "/" e (IntNum 1) = e
80binop "div" e (IntNum 1) = e
81binop "*" (IntNum 0) e = IntNum 0
82binop "*" (IntNum 1) e = e
83binop "*" (IntNum n) (Binop "*" (IntNum m) e) = binop "*" (IntNum (n*m)) e
84binop "*" (IntNum n) (Binop "*" e (IntNum m)) = binop "*" (IntNum (n*m)) e
86binop "+" e (IntNum n) = binop "+" (IntNum n) e
87binop "*" e (IntNum n) = binop "*" (IntNum n) e
89binop op (Boolean n) (Boolean m) = f n m
90 where f a b = case op of { "&&" -> Boolean $ (&&) n m
91 ; "||" -> Boolean $ (||) n m
92 ; _ -> Binop op (Boolean n) (Boolean m) }
94binop "&&" (Boolean True) e = e
95binop "&&" (Boolean False) e = Boolean False
96binop "||" (Boolean True) e = Boolean True
97binop "||" (Boolean False) e = e
99binop "&&" e (Boolean n) = binop "&&" (Boolean n) e
100binop "||" e (Boolean n) = binop "||" (Boolean n) e
102binop ":" h t = cons h t
103binop "++" (Str s1) (Str s2) = Str $ s1 ++ s2
104binop "++" (Str s1) (Binop "++" (Str s2) e) = Binop "++" (Str $ s1 ++ s2) e
105binop "++" (Binop "++" e (Str s1)) (Str s2) = Binop "++" e (Str $ s1 ++ s2)
106binop "++" (Data "Nil" []) e = e
107binop "++" e (Data "Nil" []) = e
108binop "++" (Data "Cons" [h,t]) e = Data "Cons" [h, binop "++" t e]
110binop "$" e1 e2 = App e1 e2
111binop "." e1 e2 = Lambda "x" (App e1 (App e2 (Var "x")))
113binop op e1 e2
114 | isAlpha (head op) || '_' == head op = App (App (Var op) e1) e2
115 | otherwise = Binop op e1 e2