git.iko.soy/elk
on 44b2e45 help sign in
elk/src/Initialize.hs
107 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 Lexer
10import Parser (toExpr,toDefs)
11import Rename (rename)
13import Unify
14import Hints
16{--
17initialize 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--}
24initialize 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)
31simp_loop exp = if exp == exp' then exp' else simp_loop exp'
32 where exp' = simp exp
34simp 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
47simp_if (Boolean b) e2 e3 = if b then e2 else e3
48simp_if a b c = If a b c
50simp_binop "mod" (Number n) (Number m) = Number (mod n m)
51simp_binop "mod" e1 e2 = Binop "mod" e1 e2
52simp_binop str e1 e2
53 | isAlpha (head str) || '_' == head str = App (App (Var str) e1) e2
54 | otherwise = binop str e1 e2
56binop 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) }
70binop "-" e (Number 0) = e
71binop "+" (Number 0) e = e
72binop "+" (Number n) (Binop "+" (Number m) e) = binop "+" (Number (n+m)) e
73binop "+" (Number n) (Binop "+" e (Number m)) = binop "+" (Number (n+m)) e
75binop "/" e (Number 1) = e
76binop "*" (Number 0) e = Number 0
77binop "*" (Number 1) e = e
78binop "*" (Number n) (Binop "*" (Number m) e) = binop "*" (Number (n*m)) e
79binop "*" (Number n) (Binop "*" e (Number m)) = binop "*" (Number (n*m)) e
81binop "+" e (Number n) = binop "+" (Number n) e
82binop "*" e (Number n) = binop "*" (Number n) e
84binop 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) }
89binop "&&" (Boolean True) e = e
90binop "&&" (Boolean False) e = Boolean False
91binop "||" (Boolean True) e = Boolean True
92binop "||" (Boolean False) e = e
94binop op e (Boolean n) = binop op (Boolean n) e
96binop ":" h t = cons h t
97binop "++" (Str s1) (Str s2) = Str $ s1 ++ s2
98binop "++" (Str s1) (Binop "++" (Str s2) e) = Binop "++" (Str $ s1 ++ s2) e
99binop "++" (Binop "++" e (Str s1)) (Str s2) = Binop "++" e (Str $ s1 ++ s2)
100binop "++" (Data "Nil" []) e = e
101binop "++" e (Data "Nil" []) = e
102binop "++" (Data "Cons" [h,t]) e = Data "Cons" [h, binop "++" t e]
104binop "$" e1 e2 = App e1 e2
106binop op e1 e2 = Binop op e1 e2
107--}