@@ -1,136 +0,0 @@
1−module Transform.Optimize (optimize) where
2−
3−import SourceSyntax.Declaration (Declaration(..))
4−import SourceSyntax.Expression
5−import SourceSyntax.Literal
6−import SourceSyntax.Location
7−import SourceSyntax.Module
8−import Control.Arrow (second, (***))
9−import Data.Char (isAlpha)
10−
11−optimize (Module name ims exs stmts) =
12− Module name ims exs (map optimizeStmt stmts)
13−
14−optimizeStmt stmt = if stmt == stmt' then stmt' else optimizeStmt stmt'
15− where stmt' = simp stmt
16−
17−class Simplify a where
18− simp :: a -> a
19−
20−instance Simplify (Declaration t v) where
21− simp (Definition def) = Definition (simp def)
22− simp (Port name tipe maybe) = Port name tipe (simp `fmap` maybe)
23− simp stmt = stmt
24−
25−instance Simplify (Def t v) where
26− simp (Def name e) = Def name (simp e)
27− simp x = x
28−
29−instance Simplify e => Simplify (Located e) where
30− simp (L s e) = L s (simp e)
31−
32−instance Simplify (Expr t v) where
33− simp expr =
34− let f = simp in
35− case expr of
36− Range e1 e2 -> Range (f e1) (f e2)
37− Binop op e1 e2 -> binop op (f e1) (f e2)
38− Lambda x e -> Lambda x (f e)
39− Record fs -> Record (map (second simp) fs)
40− App e1 e2 -> App (f e1) (f e2)
41− Let defs e -> Let (map simp defs) (f e)
42− Data name es -> Data name (map f es)
43− MultiIf es -> MultiIf . clipBranches $ map (f *** f) es
44− Case e cases -> Case (f e) (map (second f) cases)
45− _ -> expr
46−
47−
48−clipBranches [] = []
49−clipBranches (e:es) =
50− case e of
51− (L _ (Literal (Boolean True)), _) -> [e]
52− _ -> e : clipBranches es
53−
54−
55−isValue e =
56− case e of
57− Literal _ -> True
58− Var _ -> True
59− Data _ _ -> True
60− _ -> False
61−
62−
63−binop op ce1@(L s1 e1) ce2@(L s2 e2) =
64− let c1 = L s1
65− c2 = L s2
66− int = Literal . IntNum
67− str = Literal . Str
68− bool = Literal . Boolean
69− in
70− case (op, e1, e2) of
71− (_, Literal (IntNum n), Literal (IntNum m)) ->
72− case op of
73− { "+" -> int $ (+) n m
74− ; "-" -> int $ (-) n m
75− ; "*" -> int $ (*) n m
76− ; "^" -> int $ n ^ m
77− ; "div" -> int $ div n m
78− ; "mod" -> int $ mod n m
79− ; "rem" -> int $ rem n m
80− ; "<" -> bool $ n < m
81− ; ">" -> bool $ n > m
82− ; "<=" -> bool $ n <= m
83− ; ">=" -> bool $ n >= m
84− ; "==" -> bool $ n == m
85− ; "/=" -> bool $ n /= m
86− ; _ -> Binop op ce1 ce2 }
87− {--
88− -- flip order to move lone integers to the left
89− ("+", _, IntNum n) -> binop "+" ce2 ce1
90− ("*", _, IntNum n) -> binop "*" ce2 ce1
91−
92− ("+", IntNum 0, _) -> e2
93− ("+", IntNum n, Binop "+" (L _ (IntNum m)) ce) ->
94− binop "+" (c1 $ IntNum (n+m)) ce
95− ("+", Binop "+" (L _ (IntNum n)) ce1'
96− , Binop "+" (L _ (IntNum m)) ce2') ->
97− binop "+" (none $ IntNum (n+m)) (none $ Binop "+" ce1' ce2')
98−
99− ("*", IntNum 0, _) -> e1
100− ("*", IntNum 1, _) -> e2
101− ("*", IntNum n, Binop "*" (L _ (IntNum m)) ce) ->
102− binop "*" (none $ IntNum (n*m)) ce
103− ("*", Binop "*" (L _ (IntNum n)) ce1'
104− , Binop "*" (L _ (IntNum m)) ce2') ->
105− binop "*" (none $ IntNum (n*m)) (none $ Binop "*" ce1' ce2')
106−
107− ("-", _, IntNum 0) -> e1
108− ("/", _, IntNum 1) -> e1
109− ("div", _, IntNum 1) -> e1
110−--}
111− (_, Literal (Boolean n), Literal (Boolean m)) ->
112− case op of
113− "&&" -> bool $ n && m
114− "||" -> bool $ n || m
115− _ -> Binop op ce1 ce2
116−
117− ("&&", Literal (Boolean True), _) -> e2
118− ("&&", Literal (Boolean False), _) -> bool False
119− ("||", Literal (Boolean True), _) -> bool True
120− ("||", Literal (Boolean False), _) -> e2
121−
122− ("::", _, _) -> Data "::" [ce1, ce2]
123−
124− ("++", Literal (Str s1), Literal (Str s2)) -> str $ s1 ++ s2
125− ("++", Literal (Str s1), Binop "++" (L _ (Literal (Str s2))) ce) ->
126− Binop "++" (c1 . str $ s1 ++ s2) ce
127− ("++", Binop "++" e (L _ (Literal (Str s1))), Literal (Str s2)) ->
128− Binop "++" e (c1 . str $ s1 ++ s2)
129−
130− ("++", Data "[]" [], _) -> e2
131− ("++", _, Data "[]" []) -> e1
132− ("++", Data "::" [h,t], _) -> Data "::" [h, none $ binop "++" t ce2]
133−
134− _ | isAlpha (head op) || '_' == head op ->
135− App (none $ App (none $ Var op) ce1) ce2
136− | otherwise -> Binop op ce1 ce2