interpret

[minfp.git] / int.icl

diff --git a/int.icl b/int.icl
index 3b82750..4eeedf0 100644 (file)
--- a/int.icl
+++ b/int.icl
@@ -14,21 +14,21 @@ import Control.Monad.Trans
 import ast
 
 int :: Expression -> Either [String] Value
-int e = evalStateT (eval e >>= printer) preamble
-
-err :: String -> Eval a
-err e = liftT (Left [e])
+int e = evalStateT (eval e) preamble
 
 :: Eval a :== StateT EvalState (Either [String]) a
 :: EvalState :== [([Char], Value)]
 preamble =
-       [(['if'], Func 3 [] (Builtin ['if']))
-       ,(['eq'], Func 2 [] (Builtin ['eq']))
-       ,(['mul'], Func 2 [] (Builtin ['mul']))
-       ,(['div'], Func 2 [] (Builtin ['div']))
-       ,(['add'], Func 2 [] (Builtin ['add']))
-       ,(['sub'], Func 2 [] (Builtin ['sub']))
+       [(['_if'], Func \i->pure (Func \t->pure (Func \e->eval i >>= \(Bool b)->
+               if b (eval t) (eval e))))
+       ,(['_eq'],  binop \(Int i) (Int j)->Bool (i==j))
+       ,(['_sub'], binop \(Int i) (Int j)->Int (i-j))
+       ,(['_add'], binop \(Int i) (Int j)->Int (i+j))
+       ,(['_mul'], binop \(Int i) (Int j)->Int (i*j))
+       ,(['_div'], binop \(Int i) (Int j)->Int (i/j))
        ]
+where
+       binop op = Func \l->pure (Func \r->op <$> eval l <*> eval r)
 
 sub :: [Char] Expression Expression -> Expression
 sub ident subst (Let v b rest)
@@ -41,37 +41,10 @@ sub ident subst (Lambda v b)
        | ident <> v = Lambda v (sub ident b subst)
 sub _ _ x = x
 
-printer :: Value -> Eval Value
-printer (Func 0 args body) = eval (body args) >>= printer
-printer a = pure a
-
 eval :: Expression -> Eval Value
 eval (Let ident body rest)
-       =   modify (\vs->[(ident, Func 0 [] \_->body):vs])
-       >>| eval rest
+       = eval body >>= \v->modify (\vs->[(ident, v):vs]) >>| eval rest
 eval (Lit v) = pure v
-eval (Var v) = gets (lookup v) >>= maybe (err (toString v +++ " not found")) pure
-eval (App e1 e2) = eval e1 >>= \v->case v of
-//     (Func 0 a b) = err ("Saturated function: : " +++ toString e1)
-       (Func n as b) = pure (Func (n-1) (as ++ [e2]) b)
-//     _ = err ("Cannot apply " +++ toString e2 +++ " to " +++ toString e1)
-eval (Lambda a b) = pure (Func 1 [] (\[arg]->sub a arg b))
-eval (Builtin i as) = case (i, as) of
-       (['if'], [p,t,e]) = eval p >>= printer >>= \v->case v of
-               Bool v = eval (if v t e)
-//             _ = err ("first argument of if must be a bool but is " +++ toString v)
-       (['add'], [l,r]) = eval l >>= printer >>= \l->eval r >>= printer >>= \r->case (l,r) of
-               (Int a, Int b) = pure (Int (a + b))
-//             _ = err "add only defined for integers"
-       (['sub'], [l,r]) = eval l >>= printer >>= \l->eval r >>= printer >>= \r->case (l,r) of
-               (Int a, Int b) = pure (Int (a - b))
-//             _ = err "sub only defined for integers"
-       (['mul'], [l,r]) = eval l >>= printer >>= \l->eval r >>= printer >>= \r->case (l,r) of
-               (Int a, Int b) = pure (Int (a * b))
-//             _ = err "mul only defined for integers"
-       (['div'], [l,r]) = eval l >>= \l->eval r >>= \r->case (l,r) of
-               (Int a, Int b) = pure (Int (a / b))
-//             _ = err "div only defined for integers"
-       (['eq'], [l,r]) = eval l >>= printer >>= \l->eval r >>= printer >>= \r->case (l,r) of
-               (Int a, Int b) = pure (Bool (a == b))
-//             _ = err "eq only defined for integers"
+eval (Var v) = gets (lookup v) >>= maybe (liftT (Left [toString v +++ " not found"])) pure
+eval (App e1 e2) = eval e1 >>= \(Func v)->v e2
+eval (Lambda a b) = pure (Func \arg->eval (sub a arg b))