parsing cleaner

[minfp.git] / int.icl

diff --git a/int.icl b/int.icl
index be7e595..4cf6b78 100644 (file)
--- a/int.icl
+++ b/int.icl
@@ -14,17 +14,11 @@ import Control.Monad.Trans
 import ast
 
 int :: Expression -> Either [String] Value
-int _ = Left ["intbork"]
-/*int (AST fs) = evalStateT (mapM evalFun fs >>| getStart fs >>= eval >>= printer) preamble
+int e = evalStateT (eval e >>= printer) preamble
 
 err :: String -> Eval a
 err e = liftT (Left [e])
 
-getStart :: [Function] -> Eval Expression
-getStart [] = err "No start rule defined"
-getStart [(Function ['start'] _ e):_] = pure e
-getStart [_:fs] = getStart fs
-
 :: Eval a :== StateT EvalState (Either [String]) a
 :: EvalState :== [([Char], Value)]
 preamble =
@@ -36,24 +30,10 @@ preamble =
        ,(['sub'], Func 2 [] (Builtin ['sub']))
        ]
 
-putEnv :: [Char] Value -> Eval ()
-putEnv i v = modify (\vs->[(i,v):vs])
-
-getEnv :: [Char] -> Eval Value
-getEnv v = gets (lookup v)
-       >>= maybe (err ("Variable " +++ toString v +++ " not found")) pure
-
-evalFun :: Function -> Eval ()
-evalFun (Function v a b) = putEnv v (Func (length a) [] (\es->fun a es b))
-where
-       fun [] [] body = body
-       fun [a:as] [e:es] body = fun as es (sub a e body)
-
-printer :: Value -> Eval Value
-printer t=:(Func 0 args body) = eval (body args) >>= printer
-printer a = pure a
-
 sub :: [Char] Expression Expression -> Expression
+sub ident subst (Let v a b rest)
+       = Let v a (if (isMember ident a) b (sub ident subst b))
+               (if (v == ident) rest (sub ident subst rest))
 sub ident subst (Var v)
        | ident == v = subst
 sub ident subst (App e1 e2) = App (sub ident subst e1) (sub ident subst e2)
@@ -61,13 +41,21 @@ 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 as body rest)
+       =   modify (\vs->[(ident, Func (length as) [] \e->zipSt sub as e body):vs])
+       >>| eval rest
 eval (Lit v) = pure v
-eval (Var v) = getEnv v
+eval (Var v) = gets (lookup v)
+       >>= maybe (err ("Variable " +++ toString v +++ " not found")) pure
 eval (App e1 e2) = eval e1 >>= \v->case v of
-//     (Func 0 a b) = err "Saturated function"
+       (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)
+       _ = 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
@@ -88,4 +76,3 @@ eval (Builtin i as) = case (i, as) of
        (['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"
-*/