From: Mart Lubbers <mart@martlubbers.net>
Date: Tue, 5 Mar 2019 13:20:26 +0000 (+0100)
Subject: let
X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=6c41dc8f3b2452773a3b8c0f56e7a63505c97321;p=minfp.git

let
---

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