componetns

diff --git a/check.icl b/check.icl
index 2832d53..a2bc85a 100644 (file)
--- a/check.icl
+++ b/check.icl
@@ -7,9 +7,11 @@ import Control.Monad.State
 import Control.Monad.Trans
 import Data.Either
 import Data.Func
+import Data.Graph
 import Data.List
 import Data.Map => qualified put, union, difference, find, updateAt
 import Data.Maybe
+import Data.Tuple
 import Text
 
 import ast
@@ -21,10 +23,35 @@ 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, (foldr ((o) o Lambda) id a e))]) e fs
-                       = (\x->(e, x)) <$> runInfer (infer preamble e)
+//                     = (\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
+       # (indices, graph) = foldr mkNode (newMap, emptyGraph) fs
+       = foldr mkExpr start $ scc $ foldr (mkEdges indices) graph fs
+where
+       mkNode :: Function (Map [Char] NodeIndex, Graph Function ()) -> (Map [Char] NodeIndex, Graph Function ())
+       mkNode f=:(Function l _ _) (m, g)
+               # (i, g) = addNode f g
+               = ('Data.Map'.put l i m, g)
+
+       mkEdges :: (Map [Char] NodeIndex) Function (Graph Function ()) -> Graph Function ()
+       mkEdges m (Function l i e) g
+               # ni = fromJust (get l m)
+               = foldr (addEdge ()) g [(ni, v)\\(Just v)<-map (flip get m) $ vars e []]
+
+       vars :: Expression [[Char]] -> [[Char]]
+       vars (Var v) c = [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 _ c = c
+
+       mkExpr :: (Graph Function ()) Expression -> Expression
+       mkExpr {nodes} e = Let [(l, foldr ((o) o Lambda) id i e)\\{data=(Function l i e)}<-elems nodes] e
+
 instance toString Scheme where
        toString (Forall [] t) = toString t
        toString (Forall as t) = concat ["A.", join " " (map toString as), ": ", toString t]
@@ -148,3 +175,7 @@ infer env (Let [(x, e1)] e2)
 where
        putenv :: [Char] -> (Type TypeEnv -> TypeEnv)
        putenv k = 'Data.Map'.put k o Forall []
+
+unifyl :: [Type] -> Infer Subst
+unifyl [t1,t2:ts] = unify t1 t2 >>= \s->unifyl [t2:map (apply s) ts]
+unifyl _ = pure newMap

diff --git a/tests/preamble.mfp b/tests/preamble.mfp
index e219460..5fd27a7 100644 (file)
--- a/tests/preamble.mfp
+++ b/tests/preamble.mfp
@@ -14,4 +14,8 @@ if = code if;
 
 fac i = if (i == 0) 1 $ i * fac (i - 1);
 id x = x;
-start = fac 10;
+
+even i = if (i == 0) True (odd (i - 1));
+odd i = if (i == 0) False (even (i - 1));
+
+start = odd 5;