From: Mart Lubbers <mart@martlubbers.net>
Date: Fri, 15 Mar 2019 13:13:34 +0000 (+0100)
Subject: componetns
X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=adb730769ac52f53bc1b54bac5bca8914e525cf9;p=minfp.git

componetns
---

diff --git a/check.icl b/check.icl
index 2832d53..a2bc85a 100644
--- 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
--- 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;