| App Expression Expression
| Lambda [Char] Expression
| Builtin [Char] [Expression]
- | Let [Char] [[Char]] Expression Expression
+ | Let [Char] Expression Expression
:: Value
= Int Int
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
= 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
>>= \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)
]
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
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