@@ -1,107 +1,107 @@
1−module Language.Elm.Initialize (initialize) where
2−
3−import Ast
4−import Control.Arrow (first, second)
5−import Control.Monad
6−import Data.Char (isAlpha)
7−import Data.Maybe (mapMaybe)
8−import Data.Either (rights)
9−import Lexer
10−import Parser (toExpr,toDefs)
11−import Rename (rename)
12−
13−import Unify
14−import Hints
15−
16−{--
17−initialize str = do
18− (expr, hints') <- toDefs =<< tokenize str
19− let expr' = rename expr
20− subs <- unify (liftM2 (++) hints hints') expr'
21− return (seq subs expr')
22−--}
23−
24−initialize str = do
25− (expr, hints') <- toDefs =<< tokenize str
26− let expr' = rename expr
27− subs <- unify (liftM2 (++) hints hints') expr'
28− let init = simp_loop expr'
29− return (seq subs init)
30−
31−simp_loop exp = if exp == exp' then exp' else simp_loop exp'
32− where exp' = simp exp
33−
34−simp expr =
35− let f = simp in
36− case expr of
37− Range e1 e2 -> Range (f e1) (f e2)
38− Binop op e1 e2 -> simp_binop op (f e1) (f e2)
39− Lambda x e -> Lambda x (f e)
40− App e1 e2 -> App (f e1) (f e2)
41− If e1 e2 e3 -> simp_if (f e1) (f e2) (f e3)
42− Let defs e -> Let (map (second f) defs) (f e)
43− Data name es -> Data name (map f es)
44− Case e cases -> Case (f e) (map (second f) cases)
45− _ -> expr
46−
47−simp_if (Boolean b) e2 e3 = if b then e2 else e3
48−simp_if a b c = If a b c
49−
50−simp_binop "mod" (Number n) (Number m) = Number (mod n m)
51−simp_binop "mod" e1 e2 = Binop "mod" e1 e2
52−simp_binop str e1 e2
53− | isAlpha (head str) || '_' == head str = App (App (Var str) e1) e2
54− | otherwise = binop str e1 e2
55−
56−binop op (Number n) (Number m) = f n m
57− where f a b = case op of
58− { "+" -> Number $ (+) a b
59− ; "-" -> Number $ (-) a b
60− ; "*" -> Number $ (*) a b
61− --; "/" -> Number $ div a b
62− ; "<" -> Boolean $ a < b
63− ; ">" -> Boolean $ a < b
64− ; "<=" -> Boolean $ a <= b
65− ; ">=" -> Boolean $ a >= b
66− ; "==" -> Boolean $ a == b
67− ; "/=" -> Boolean $ a /= b
68− ; _ -> Binop op (Number n) (Number m) }
69−
70−binop "-" e (Number 0) = e
71−binop "+" (Number 0) e = e
72−binop "+" (Number n) (Binop "+" (Number m) e) = binop "+" (Number (n+m)) e
73−binop "+" (Number n) (Binop "+" e (Number m)) = binop "+" (Number (n+m)) e
74−
75−binop "/" e (Number 1) = e
76−binop "*" (Number 0) e = Number 0
77−binop "*" (Number 1) e = e
78−binop "*" (Number n) (Binop "*" (Number m) e) = binop "*" (Number (n*m)) e
79−binop "*" (Number n) (Binop "*" e (Number m)) = binop "*" (Number (n*m)) e
80−
81−binop "+" e (Number n) = binop "+" (Number n) e
82−binop "*" e (Number n) = binop "*" (Number n) e
83−
84−binop op (Boolean n) (Boolean m) = f n m
85− where f a b = case op of { "&&" -> Boolean $ (&&) n m
86− ; "||" -> Boolean $ (||) n m
87− ; _ -> Binop op (Boolean n) (Boolean m) }
88−
89−binop "&&" (Boolean True) e = e
90−binop "&&" (Boolean False) e = Boolean False
91−binop "||" (Boolean True) e = Boolean True
92−binop "||" (Boolean False) e = e
93−
94−binop op e (Boolean n) = binop op (Boolean n) e
95−
96−binop ":" h t = cons h t
97−binop "++" (Str s1) (Str s2) = Str $ s1 ++ s2
98−binop "++" (Str s1) (Binop "++" (Str s2) e) = Binop "++" (Str $ s1 ++ s2) e
99−binop "++" (Binop "++" e (Str s1)) (Str s2) = Binop "++" e (Str $ s1 ++ s2)
100−binop "++" (Data "Nil" []) e = e
101−binop "++" e (Data "Nil" []) = e
102−binop "++" (Data "Cons" [h,t]) e = Data "Cons" [h, binop "++" t e]
103−
104−binop "$" e1 e2 = App e1 e2
105−
106−binop op e1 e2 = Binop op e1 e2
1+module Initialize (initialize) where
2+
3+import Ast
4+import Control.Arrow (first, second)
5+import Control.Monad
6+import Data.Char (isAlpha)
7+import Data.Maybe (mapMaybe)
8+import Data.Either (rights)
9+import Lexer
10+import Parser (toExpr,toDefs)
11+import Rename (rename)
12+
13+import Unify
14+import Hints
15+
16+{--
17+initialize str = do
18+ (expr, hints') <- toDefs =<< tokenize str
19+ let expr' = rename expr
20+ subs <- unify (liftM2 (++) hints hints') expr'
21+ return (seq subs expr')
22+--}
23+
24+initialize str = do
25+ (expr, hints') <- toDefs =<< tokenize str
26+ let expr' = rename expr
27+ subs <- unify (liftM2 (++) hints hints') expr'
28+ let init = simp_loop expr'
29+ return (seq subs init)
30+
31+simp_loop exp = if exp == exp' then exp' else simp_loop exp'
32+ where exp' = simp exp
33+
34+simp expr =
35+ let f = simp in
36+ case expr of
37+ Range e1 e2 -> Range (f e1) (f e2)
38+ Binop op e1 e2 -> simp_binop op (f e1) (f e2)
39+ Lambda x e -> Lambda x (f e)
40+ App e1 e2 -> App (f e1) (f e2)
41+ If e1 e2 e3 -> simp_if (f e1) (f e2) (f e3)
42+ Let defs e -> Let (map (second f) defs) (f e)
43+ Data name es -> Data name (map f es)
44+ Case e cases -> Case (f e) (map (second f) cases)
45+ _ -> expr
46+
47+simp_if (Boolean b) e2 e3 = if b then e2 else e3
48+simp_if a b c = If a b c
49+
50+simp_binop "mod" (Number n) (Number m) = Number (mod n m)
51+simp_binop "mod" e1 e2 = Binop "mod" e1 e2
52+simp_binop str e1 e2
53+ | isAlpha (head str) || '_' == head str = App (App (Var str) e1) e2
54+ | otherwise = binop str e1 e2
55+
56+binop op (Number n) (Number m) = f n m
57+ where f a b = case op of
58+ { "+" -> Number $ (+) a b
59+ ; "-" -> Number $ (-) a b
60+ ; "*" -> Number $ (*) a b
61+ --; "/" -> Number $ div a b
62+ ; "<" -> Boolean $ a < b
63+ ; ">" -> Boolean $ a < b
64+ ; "<=" -> Boolean $ a <= b
65+ ; ">=" -> Boolean $ a >= b
66+ ; "==" -> Boolean $ a == b
67+ ; "/=" -> Boolean $ a /= b
68+ ; _ -> Binop op (Number n) (Number m) }
69+
70+binop "-" e (Number 0) = e
71+binop "+" (Number 0) e = e
72+binop "+" (Number n) (Binop "+" (Number m) e) = binop "+" (Number (n+m)) e
73+binop "+" (Number n) (Binop "+" e (Number m)) = binop "+" (Number (n+m)) e
74+
75+binop "/" e (Number 1) = e
76+binop "*" (Number 0) e = Number 0
77+binop "*" (Number 1) e = e
78+binop "*" (Number n) (Binop "*" (Number m) e) = binop "*" (Number (n*m)) e
79+binop "*" (Number n) (Binop "*" e (Number m)) = binop "*" (Number (n*m)) e
80+
81+binop "+" e (Number n) = binop "+" (Number n) e
82+binop "*" e (Number n) = binop "*" (Number n) e
83+
84+binop op (Boolean n) (Boolean m) = f n m
85+ where f a b = case op of { "&&" -> Boolean $ (&&) n m
86+ ; "||" -> Boolean $ (||) n m
87+ ; _ -> Binop op (Boolean n) (Boolean m) }
88+
89+binop "&&" (Boolean True) e = e
90+binop "&&" (Boolean False) e = Boolean False
91+binop "||" (Boolean True) e = Boolean True
92+binop "||" (Boolean False) e = e
93+
94+binop op e (Boolean n) = binop op (Boolean n) e
95+
96+binop ":" h t = cons h t
97+binop "++" (Str s1) (Str s2) = Str $ s1 ++ s2
98+binop "++" (Str s1) (Binop "++" (Str s2) e) = Binop "++" (Str $ s1 ++ s2) e
99+binop "++" (Binop "++" e (Str s1)) (Str s2) = Binop "++" e (Str $ s1 ++ s2)
100+binop "++" (Data "Nil" []) e = e
101+binop "++" e (Data "Nil" []) = e
102+binop "++" (Data "Cons" [h,t]) e = Data "Cons" [h, binop "++" t e]
103+
104+binop "$" e1 e2 = App e1 e2
105+
106+binop op e1 e2 = Binop op e1 e2
107107--}