git.iko.soy/elk
on b5b87f2 help sign in
elk/elm/src/Optimize.hs
93 lines 3.3 kB history raw
1module Optimize (optimize) where
3import Ast
4import Control.Arrow (second)
5import Data.Char (isAlpha)
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 e1 e2 -> App (f e1) (f e2)
25 If e1 e2 e3 -> simp_if (f e1) (f e2) (f e3)
26 Let defs e -> Let (map simpDef defs) (f e)
27 where simpDef (Definition func args e) = Definition func args (f e)
28 Data name es -> Data name (map f es)
29 Case e cases -> Case (f e) (map (second f) cases)
30 _ -> expr
32simp_if (Boolean b) e2 e3 = if b then e2 else e3
33simp_if a b c = If a b c
35simp_binop = binop
37binop op (IntNum n) (IntNum m) = f n m
38 where f a b = case op of
39 { "+" -> IntNum $ (+) a b
40 ; "-" -> IntNum $ (-) a b
41 ; "*" -> IntNum $ (*) a b
42 ; "div" -> IntNum $ div a b
43 ; "mod" -> IntNum $ mod a b
44 ; "<" -> Boolean $ a < b
45 ; ">" -> Boolean $ a < b
46 ; "<=" -> Boolean $ a <= b
47 ; ">=" -> Boolean $ a >= b
48 ; "==" -> Boolean $ a == b
49 ; "/=" -> Boolean $ a /= b
50 ; _ -> Binop op (IntNum n) (IntNum m) }
52binop "-" e (IntNum 0) = e
53binop "+" (IntNum 0) e = e
54binop "+" e (IntNum 0) = e
55binop "+" (IntNum n) (Binop "+" (IntNum m) e) = binop "+" (IntNum (n+m)) e
56binop "+" (IntNum n) (Binop "+" e (IntNum m)) = binop "+" (IntNum (n+m)) e
58binop "/" e (IntNum 1) = e
59binop "div" e (IntNum 1) = e
60binop "*" (IntNum 0) e = IntNum 0
61binop "*" (IntNum 1) e = e
62binop "*" (IntNum n) (Binop "*" (IntNum m) e) = binop "*" (IntNum (n*m)) e
63binop "*" (IntNum n) (Binop "*" e (IntNum m)) = binop "*" (IntNum (n*m)) e
65binop "+" e (IntNum n) = binop "+" (IntNum n) e
66binop "*" e (IntNum n) = binop "*" (IntNum n) e
68binop op (Boolean n) (Boolean m) = f n m
69 where f a b = case op of { "&&" -> Boolean $ (&&) n m
70 ; "||" -> Boolean $ (||) n m
71 ; _ -> Binop op (Boolean n) (Boolean m) }
73binop "&&" (Boolean True) e = e
74binop "&&" (Boolean False) e = Boolean False
75binop "||" (Boolean True) e = Boolean True
76binop "||" (Boolean False) e = e
78binop "&&" e (Boolean n) = binop "&&" (Boolean n) e
79binop "||" e (Boolean n) = binop "||" (Boolean n) e
81binop ":" h t = cons h t
82binop "++" (Str s1) (Str s2) = Str $ s1 ++ s2
83binop "++" (Str s1) (Binop "++" (Str s2) e) = Binop "++" (Str $ s1 ++ s2) e
84binop "++" (Binop "++" e (Str s1)) (Str s2) = Binop "++" e (Str $ s1 ++ s2)
85binop "++" (Data "Nil" []) e = e
86binop "++" e (Data "Nil" []) = e
87binop "++" (Data "Cons" [h,t]) e = Data "Cons" [h, binop "++" t e]
89binop "$" e1 e2 = App e1 e2
91binop op e1 e2
92 | isAlpha (head op) || '_' == head op = App (App (Var op) e1) e2
93 | otherwise = Binop op e1 e2