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