start support for recursive let

diff --git a/ast.dcl b/ast.dcl
index 5f7b1b5..7dd17d7 100644 (file)
--- a/ast.dcl
+++ b/ast.dcl
@@ -12,7 +12,7 @@ from int import :: Eval
        | Var [Char]
        | App Expression Expression
        | Lambda [Char] Expression
-       | Let [Char] Expression Expression
+       | Let [([Char], Expression)] Expression
 
 :: Value
        = Int Int

diff --git a/ast.icl b/ast.icl
index a240b55..9280dd3 100644 (file)
--- a/ast.icl
+++ b/ast.icl
@@ -13,7 +13,10 @@ instance toString Expression where
        toString (Var s) = toString s
        toString (App l r) = concat ["(", toString l, " ", toString r, ")"]
        toString (Lambda a e) = concat ["(\\", toString a, ".", toString e, ")"]
-       toString (Let i b r) = concat [toString i, " = ", toString b, "\n", toString r]
+       toString (Let ns r) = concat
+               [ "let\n"
+               , concat [concat ["\t", toString n, " = ", toString v, "\n"]\\(n, v)<-ns]
+               , " in\n", toString r]
        toString _ = abort "toString Expression not implemented"
 
 instance toString Value where

diff --git a/check.icl b/check.icl
index 8a4ea5c..b0e078d 100644 (file)
--- a/check.icl
+++ b/check.icl
@@ -21,7 +21,7 @@ check fs
        = case partition (\a->a=:(Function ['start'] _ _)) fs of
                ([], _) = Left ["No start function defined"]
                ([Function _ [] e], fs)
-                       # e = foldr (\(Function i a e)->Let i (foldr ((o) o Lambda) id a e)) e fs
+                       # e = foldr (\(Function i a e)->Let [(i, (foldr ((o) o Lambda) id a e))]) e fs
                        = (\x->(e, x)) <$> runInfer (infer preamble e)
                ([Function _ _ _], _) = Left ["Start cannot have arguments"]
 
@@ -129,7 +129,7 @@ infer env (Lambda x b)
 //     =              infer env e1
 //     >>= \(s1, t1)->infer ('Data.Map'.put x (generalize (apply s1 env) t1) env) e2
 //     >>= \(s2, t2)->pure (s1 oo s2, t2)
-infer env (Let x e1 e2)
+infer env (Let [(x, e1)] e2)
        =              fresh
        >>= \tv->      infer ('Data.Map'.put x (Forall [] tv) env) e1
        >>= \(s1, t1)->infer ('Data.Map'.put x (generalize (apply s1 env) t1) env) e2

diff --git a/int.icl b/int.icl
index eec77c4..475e9b4 100644 (file)
--- a/int.icl
+++ b/int.icl
@@ -5,6 +5,7 @@ import Data.Either
 import Data.Functor
 import Data.Maybe
 import Data.List
+import Data.Tuple
 import Control.Applicative
 import Control.Monad
 import Control.Monad.State
@@ -16,9 +17,7 @@ import ast
 :: EvalState :== [([Char], Value)]
 
 int :: Expression -> Either [String] Value
-int e = evalStateT (eval e) preamble
-
-preamble =
+int e = evalStateT (eval e)
        [(['_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))
@@ -30,7 +29,9 @@ 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) = Let v (sub ident subst b) (if (v == ident) rest (sub ident subst rest))
+sub ident subst (Let ns rest)
+       | not (isMember ident (map fst ns))
+               = Let (fmap (sub ident subst) <$> ns) (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)
@@ -39,7 +40,7 @@ sub ident subst (Lambda v b)
 sub _ _ x = x
 
 eval :: Expression -> Eval Value
-eval (Let ident body rest) = eval body >>= \v->modify (\vs->[(ident, v):vs]) >>| eval rest
+eval (Let ns rest) = sequence [eval v >>= \v->modify (\vs->[(n, v):vs])\\(n, v)<-ns] >>| eval rest
 eval (Lit v) = pure v
 eval (Var v) = gets (lookup v) >>= maybe (liftT (Left [toString v +++ " not found"])) pure
 eval (App e1 e2) = eval e1 >>= \(Func v)->v e2

diff --git a/tests/preamble.mfp b/tests/preamble.mfp
index bfceec2..617b195 100644 (file)
--- a/tests/preamble.mfp
+++ b/tests/preamble.mfp
@@ -6,4 +6,4 @@ $ ifxr 0 x y = x y;
 + ifxl 6 = code add;
 if = code if;
 fac i = if (i == 0) 1 (i * fac (i - 1));
-start = fac 5;
+start = fac 15;