From: Mart Lubbers <mart@martlubbers.net>
Date: Thu, 7 Mar 2019 13:44:36 +0000 (+0100)
Subject: start support for recursive let
X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=d5d3137538f5add36e8fb04b102cfb6f2348093b;p=minfp.git

start support for recursive let
---

diff --git a/ast.dcl b/ast.dcl
index 5f7b1b5..7dd17d7 100644
--- 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
--- 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
--- 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
--- 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
--- 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;