separate
[minfp.git] / check.icl
index 43d2b30..2bef9ed 100644 (file)
--- a/check.icl
+++ b/check.icl
@@ -13,7 +13,10 @@ import Data.Maybe
 import Data.Tuple
 import Text
 
-import ast
+import ast, scc
+
+import Text.GenPrint
+import StdDebug
 
 check :: [Function] -> Either [String] (Expression, Scheme)
 check fs
@@ -26,54 +29,6 @@ check fs
                        = pure (makeExpression fs e, undef)
                ([Function _ _ _], _) = Left ["Start cannot have arguments"]
 
-
-:: Node a :== (a, [a])
-:: SCCState a =
-       { index :: Int
-       , stack :: [a]
-       , map   :: Map a (Int, Int, Bool)
-       , sccs  :: [[a]]
-       }
-
-import StdDebug
-import Text.GenPrint
-scc :: [Node a] -> [[a]] | Eq, Ord a
-scc nodes = (foldr scc` {index=0,stack=[],map=newMap,sccs=[]} nodes).sccs
-where
-//     scc` :: (Node a) (SCCState a) -> SCCState a | Eq, Ord a
-       scc` (v, suc) s = maybe (strongconnect s (v, suc)) (\_->s) $ get v s.map
-
-//     strongconnect :: (SCCState a) (Node a)-> SCCState a | Eq, Ord a
-       strongconnect s (v, suc)
-               # s = flip (foldr processSucc) suc
-                       { s
-                       & map   = 'Data.Map'.put v (s.index, s.index, True) s.map
-                       , stack = [v:s.stack]
-                       , index = s.index + 1
-                       }
-               # (Just (iv, lv, lo)) = get v s.map
-               | iv == lv
-                       # (scc, [sl:stack]) = span ((<>) v) s.stack
-                       # scc = scc ++ [sl]
-                       = { s
-                         & sccs = [scc:s.sccs]
-                         , stack= stack
-                         , map  = foldr (\w m->'Data.Map'.put w (appThd3 (\_->False) $ fromJust (get w m)) m) s.map scc
-                         }
-               = s
-       where
-//             processSucc :: a (SCCState a) -> SCCState a | Eq, Ord a
-               processSucc w s = case get w s.map of
-                       Nothing
-                               # s = strongconnect s $ hd [l\\l=:(n, _)<-nodes | n == w]
-                               # (Just (iw, lw, ow)) = get w s.map
-                               # (Just (iv, lv, ov)) = get v s.map
-                               = {s & map='Data.Map'.put v (iv, min lv lw, ov) s.map}
-                       Just (iw, lw, True)
-                               # (Just (iv, lv, ov)) = get v s.map
-                               = {s & map='Data.Map'.put v (iv, min iw lv, ov) s.map}
-                       Just _ = s
-
 makeExpression :: [Function] Expression -> Expression
 makeExpression fs start
        = mkExpr $ scc [(l, vars e [])\\(l, e)<-nicefuns]