From d5d3137538f5add36e8fb04b102cfb6f2348093b Mon Sep 17 00:00:00 2001 From: Mart Lubbers Date: Thu, 7 Mar 2019 14:44:36 +0100 Subject: [PATCH] start support for recursive let --- ast.dcl | 2 +- ast.icl | 5 ++++- check.icl | 4 ++-- int.icl | 11 ++++++----- tests/preamble.mfp | 2 +- 5 files changed, 14 insertions(+), 10 deletions(-) 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; -- 2.20.1