@@ -1,10 +1,9 @@
1−module Optimize (optimize) where
1+module Transform.Optimize (optimize) where
22
3−import Ast
4−import Located
3+import SourceSyntax.Everything
54import Control.Arrow (second, (***))
65import Data.Char (isAlpha)
7−import Substitute
6+import Transform.Substitute
87
98optimize (Module name ims exs stmts) =
109 Module name ims exs (map optimizeStmt stmts)
@@ -15,12 +14,12 @@ optimizeStmt stmt = if stmt == stmt' then stmt' else optimizeStmt stmt'
1514class Simplify a where
1615 simp :: a -> a
1716
18−instance Simplify Statement where
17+instance Simplify (Declaration t v) where
1918 simp (Definition def) = Definition (simp def)
2019 simp (ImportEvent js b elm t) = ImportEvent js (simp b) elm t
2120 simp stmt = stmt
2221
23−instance Simplify Def where
22+instance Simplify (Def t v) where
2423 simp (FnDef func args e) = FnDef func args (simp e)
2524 simp (OpDef op a1 a2 e) = OpDef op a1 a2 (simp e)
2625 simp x = x
@@ -28,12 +27,12 @@ instance Simplify Def where
2827instance Simplify e => Simplify (Located e) where
2928 simp (L t s e) = L t s (simp e)
3029
31−instance Simplify Expr where
30+instance Simplify (Expr t v) where
3231 simp expr =
3332 let f = simp in
3433 case expr of
3534 Range e1 e2 -> Range (f e1) (f e2)
36− Binop op e1 e2 -> simp_binop op (f e1) (f e2)
35+ Binop op e1 e2 -> binop op (f e1) (f e2)
3736 Lambda x e -> Lambda x (f e)
3837 Record fs -> Record (map (\(f,as,e) -> (f, as, simp e)) fs)
3938 App (L t s (Lambda x e1)) e2 ->
@@ -51,41 +50,43 @@ instance Simplify Expr where
5150clipBranches [] = []
5251clipBranches (e:es) =
5352 case e of
54− (L _ _ (Boolean True), _) -> [e]
53+ (L _ _ (Literal (Boolean True)), _) -> [e]
5554 _ -> e : clipBranches es
5655
5756
5857isValue e =
59− case e of { IntNum _ -> True
60− ; FloatNum _ -> True
61− ; Chr _ -> True
62− ; Str _ -> True
63− ; Boolean _ -> True
64− ; Var _ -> True
65− ; Data _ _ -> True
66− ; _ -> False }
58+ case e of
59+ Literal _ -> True
60+ Var _ -> True
61+ Data _ _ -> True
62+ _ -> False
6763
68−simp_binop = binop
6964
7065binop op ce1@(L t1 s1 e1) ce2@(L t2 s2 e2) =
71− let c1 = L t1 s1 in
72− let c2 = L t2 s2 in
66+ let c1 = L t1 s1
67+ c2 = L t2 s2
68+ int = Literal . IntNum
69+ str = Literal . Str
70+ bool = Literal . Boolean
71+ in
7372 case (op, e1, e2) of
74− (_, IntNum n, IntNum m) -> case op of
75− { "+" -> IntNum $ (+) n m
76− ; "-" -> IntNum $ (-) n m
77− ; "*" -> IntNum $ (*) n m
78− ; "^" -> IntNum $ n ^ m
79− ; "div" -> IntNum $ div n m
80− ; "mod" -> IntNum $ mod n m
81− ; "<" -> Boolean $ n < m
82− ; ">" -> Boolean $ n < m
83− ; "<=" -> Boolean $ n <= m
84− ; ">=" -> Boolean $ n >= m
85− ; "==" -> Boolean $ n == m
86− ; "/=" -> Boolean $ n /= m
87− ; _ -> Binop op ce1 ce2 }
88−
73+ (_, Literal (IntNum n), Literal (IntNum m)) ->
74+ case op of
75+ { "+" -> int $ (+) n m
76+ ; "-" -> int $ (-) n m
77+ ; "*" -> int $ (*) n m
78+ ; "^" -> int $ n ^ m
79+ ; "div" -> int $ div n m
80+ ; "mod" -> int $ mod n m
81+ ; "rem" -> int $ rem n m
82+ ; "<" -> bool $ n < m
83+ ; ">" -> bool $ n < m
84+ ; "<=" -> bool $ n <= m
85+ ; ">=" -> bool $ n >= m
86+ ; "==" -> bool $ n == m
87+ ; "/=" -> bool $ n /= m
88+ ; _ -> Binop op ce1 ce2 }
89+ {--
8990 -- flip order to move lone integers to the left
9091 ("+", _, IntNum n) -> binop "+" ce2 ce1
9192 ("*", _, IntNum n) -> binop "*" ce2 ce1
@@ -95,47 +96,49 @@ binop op ce1@(L t1 s1 e1) ce2@(L t2 s2 e2) =
9596 binop "+" (c1 $ IntNum (n+m)) ce
9697 ("+", Binop "+" (L _ _ (IntNum n)) ce1'
9798 , Binop "+" (L _ _ (IntNum m)) ce2') ->
98− binop "+" (notLocated $ IntNum (n+m)) (notLocated $ Binop "+" ce1' ce2')
99+ binop "+" (none $ IntNum (n+m)) (none $ Binop "+" ce1' ce2')
99100
100101 ("*", IntNum 0, _) -> e1
101102 ("*", IntNum 1, _) -> e2
102103 ("*", IntNum n, Binop "*" (L _ _ (IntNum m)) ce) ->
103− binop "*" (notLocated $ IntNum (n*m)) ce
104+ binop "*" (none $ IntNum (n*m)) ce
104105 ("*", Binop "*" (L _ _ (IntNum n)) ce1'
105106 , Binop "*" (L _ _ (IntNum m)) ce2') ->
106− binop "*" (notLocated $ IntNum (n*m)) (notLocated $ Binop "*" ce1' ce2')
107+ binop "*" (none $ IntNum (n*m)) (none $ Binop "*" ce1' ce2')
107108
108109 ("-", _, IntNum 0) -> e1
109110 ("/", _, IntNum 1) -> e1
110111 ("div", _, IntNum 1) -> e1
111−
112− (_, Boolean n, Boolean m) -> case op of "&&" -> Boolean $ n && m
113− "||" -> Boolean $ n || m
114− _ -> Binop op ce1 ce2
115−
116− ("&&", Boolean True, _) -> e2
117− ("&&", Boolean False, _) -> Boolean False
118− ("||", Boolean True, _) -> Boolean True
119− ("||", Boolean False, _) -> e2
112+--}
113+ (_, Literal (Boolean n), Literal (Boolean m)) ->
114+ case op of
115+ "&&" -> bool $ n && m
116+ "||" -> bool $ n || m
117+ _ -> Binop op ce1 ce2
118+
119+ ("&&", Literal (Boolean True), _) -> e2
120+ ("&&", Literal (Boolean False), _) -> bool False
121+ ("||", Literal (Boolean True), _) -> bool True
122+ ("||", Literal (Boolean False), _) -> e2
120123
121124 ("::", _, _) -> let (L _ _ e) = cons ce1 ce2 in e
122125
123− ("++", Str s1, Str s2) -> Str $ s1 ++ s2
124− ("++", Str s1, Binop "++" (L _ _ (Str s2)) ce) ->
125− Binop "++" (c1 $ Str $ s1 ++ s2) ce
126− ("++", Binop "++" e (L _ _ (Str s1)), Str s2) ->
127− Binop "++" e (c1 $ Str $ s1 ++ s2)
126+ ("++", Literal (Str s1), Literal (Str s2)) -> str $ s1 ++ s2
127+ ("++", Literal (Str s1), Binop "++" (L _ _ (Literal (Str s2))) ce) ->
128+ Binop "++" (c1 . str $ s1 ++ s2) ce
129+ ("++", Binop "++" e (L _ _ (Literal (Str s1))), Literal (Str s2)) ->
130+ Binop "++" e (c1 . str $ s1 ++ s2)
128131
129132 ("++", Data "Nil" [], _) -> e2
130133 ("++", _, Data "Nil" []) -> e1
131− ("++", Data "Cons" [h,t], _) -> Data "Cons" [h, notLocated $ binop "++" t ce2]
134+ ("++", Data "Cons" [h,t], _) -> Data "Cons" [h, none $ binop "++" t ce2]
132135
133136 ("|>", _, _) -> App ce2 ce1
134137 ("<|", _, _) -> App ce1 ce2
135138 (".", _, _) ->
136− Lambda "x" (notLocated $
137− App ce1 (notLocated $ App ce2 (notLocated $ Var "x")))
139+ Lambda "x" (none $
140+ App ce1 (none $ App ce2 (none $ Var "x")))
138141
139142 _ | isAlpha (head op) || '_' == head op ->
140− App (notLocated $ App (notLocated $ Var op) ce1) ce2
141− | otherwise -> Binop op ce1 ce2
143+ App (none $ App (none $ Var op) ce1) ce2
144+ | otherwise -> Binop op ce1 ce2