let
authorMart Lubbers <mart@martlubbers.net>
Tue, 5 Mar 2019 13:20:26 +0000 (14:20 +0100)
committerMart Lubbers <mart@martlubbers.net>
Tue, 5 Mar 2019 13:20:26 +0000 (14:20 +0100)
ast.dcl
ast.icl
check.icl
int.icl

diff --git a/ast.dcl b/ast.dcl
index c8f4c35..029f0fe 100644 (file)
--- 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 (file)
--- 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
index 7d02871..73d5ee8 100644 (file)
--- 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 (file)
--- a/int.icl
+++ b/int.icl
@@ -31,8 +31,8 @@ preamble =
        ]
 
 sub :: [Char] Expression Expression -> Expression
-sub ident subst (Let v 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