From 6c41dc8f3b2452773a3b8c0f56e7a63505c97321 Mon Sep 17 00:00:00 2001 From: Mart Lubbers Date: Tue, 5 Mar 2019 14:20:26 +0100 Subject: [PATCH] let --- ast.dcl | 2 +- ast.icl | 2 +- check.icl | 11 +++++++++-- int.icl | 8 ++++---- 4 files changed, 15 insertions(+), 8 deletions(-) diff --git a/ast.dcl b/ast.dcl index c8f4c35..029f0fe 100644 --- a/ast.dcl +++ b/ast.dcl @@ -10,7 +10,7 @@ from StdOverloaded import class toString | App Expression Expression | Lambda [Char] Expression | Builtin [Char] [Expression] - | Let [Char] [[Char]] Expression Expression + | Let [Char] Expression Expression :: Value = Int Int diff --git a/ast.icl b/ast.icl index acad3d2..cb131be 100644 --- a/ast.icl +++ b/ast.icl @@ -12,7 +12,7 @@ instance toString Expression where toString (App l r) = concat ["(", toString l, " ", toString r, ")"] toString (Lambda a e) = concat ["(\\", toString a, ".", toString e, ")"] toString (Builtin v as) = concat ["'", toString v, "'", join " " (map toString as)] - toString (Let i a b r) = concat [toString i, " ", join " " (map toString a), " = ", toString b, "\n", toString r] + toString (Let i b r) = concat [toString i, " = ", toString b, "\n", toString r] toString _ = abort "toString Expression not implemented" instance toString Value where diff --git a/check.icl b/check.icl index 7d02871..73d5ee8 100644 --- a/check.icl +++ b/check.icl @@ -25,13 +25,17 @@ 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 a e) e fs + # e = foldr (\(Function i a e)->Let i (mkLambda a e)) e fs = case runInfer (infer 'Data.Map'.newMap e) of Left e = Left e Right s = Left [printToString s] ([Function _ _ _], _) = Left ["Start cannot have arguments"] +mkLambda :: [[Char]] Expression -> Expression +mkLambda [] e = e +mkLambda [a:as] e = Lambda a (mkLambda as e) + import Text.GenPrint derive gPrint Scheme, Type @@ -141,4 +145,7 @@ infer env (Lambda x b) >>= \tv-> infer ('Data.Map'.put x (Forall [] tv) env) b >>= \(s1, t1)->pure (s1, TFun (apply s1 tv) t1) infer env (Builtin c a) = undef -infer env (Let i args e b) = undef +infer env (Let x e1 e2) + = infer env e1 + >>= \(s1, t1)->let env` = apply s1 env in infer ('Data.Map'.put x (generalize env` t1) env) e2 + >>= \(s2, t2)->pure (compose s1 s2, t2) diff --git a/int.icl b/int.icl index 78f2c1f..3b82750 100644 --- a/int.icl +++ b/int.icl @@ -31,8 +31,8 @@ preamble = ] 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)) +sub ident subst (Let v b rest) + = Let v (sub ident subst b) (if (v == ident) rest (sub ident subst rest)) sub ident subst (Var v) | ident == v = subst @@ -46,8 +46,8 @@ 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 (Let ident body rest) + = modify (\vs->[(ident, Func 0 [] \_->body):vs]) >>| eval rest eval (Lit v) = pure v eval (Var v) = gets (lookup v) >>= maybe (err (toString v +++ " not found")) pure -- 2.20.1