= case partition (\a->a=:(Function ['start'] _ _)) fs of
([], _) = Left ["No start function defined"]
([Function _ [] e], fs)
-// = (\x->(e, x)) <$> runInfer (infer preamble (makeExpression fs e))
- = pure (makeExpression fs e, undef)
+ = (\x->(e, x)) <$> runInfer (infer preamble (makeExpression fs e))
+// = pure (makeExpression fs e, undef)
([Function _ _ _], _) = Left ["Start cannot have arguments"]
makeExpression :: [Function] Expression -> Expression
makeExpression fs start
- = mkExpr $ scc [(l, vars e [])\\(l, e)<-nicefuns]
+ = foldr mkExpr start $ scc [(l, vars e [])\\(l, e)<-nicefuns]
where
- mkExpr :: [[[Char]]] -> Expression
- mkExpr t = trace_n (printToString t) start
+ mkExpr :: [[Char]] -> (Expression -> Expression)
+ mkExpr scc = Let [(l, e)\\(l, e)<-nicefuns, s<-scc | s == l]
+
+ nicefuns :: [([Char], Expression)]
nicefuns = [(l, foldr ((o) o Lambda) id i e)\\(Function l i e)<-fs]
vars :: Expression [[Char]] -> [[Char]]
vars (Var v=:[m:_]) c
- | m <> '_' = [v:c]
+ = [v:c]
+// | m <> '_' = [v:c]
vars (App l r) c = vars l $ vars r c
vars (Lambda l e) c = [v\\v<-vars e c | v <> l]
- vars (Let ns e) c = vars e c // TODO
+ vars (Let ns e) c = flatten
+ [ [v\\v<-vars e c | not (isMember v (map fst ns))]
+ : map (\(i, e)->[v\\v<-vars e [] | v <> i]) ns]
vars _ c = c
instance toString Scheme where
>>= \(s1,t1)-> unify t1 tv
>>= \t->infer ('Data.Map'.put x (generalize (apply s1 env`) t1) env`) e2
>>= \(s2, t2)->pure (s1 oo s2, t2)
+infer env (Let _ _)
+ = liftT (Left ["Mutual recursion typechecking not implemented yet"])
//infer env (Let xs e2)
// # (ns, bs) = unzip xs
// = sequence [fresh\\_<-ns]