@@ -5,10 +5,11 @@ import Control.Monad.Error
55import Data.List (nub)
66import qualified Data.Map as Map
77import Data.Data
8−import Data.List (intercalate,partition)
8+import qualified Data.Graph as Graph
9+import qualified Data.List as List
910import System.Exit
1011import System.FilePath as FP
11−import Text.PrettyPrint (Doc)
12+import Text.PrettyPrint as P
1213
1314import SourceSyntax.Everything
1415import SourceSyntax.Declaration (Assoc)
@@ -22,21 +23,24 @@ import qualified Type.Inference as TI
2223import qualified Type.Constrain.Declaration as TcDecl
2324import qualified Type.Type as T
2425
26+import System.IO.Unsafe
2527
26−buildFromSource :: (Data t, Data v) => Bool -> String -> Either [Doc] (MetadataModule t v)
28+
29+buildFromSource :: (Data t, Data v) => Bool -> String -> Either [P.Doc] (MetadataModule t v)
2730buildFromSource noPrelude src =
2831 do modul <- Parse.program src
2932
3033 -- check for structural errors
3134 Module names exs ims decls <- checkMistakes modul
3235
33− -- reorder AST into strongly connected components
36+
3437 let metaModule = MetadataModule {
3538 names = names,
3639 path = FP.joinPath names,
3740 exports = exs,
3841 imports = ims,
39− defs = fst . SD.flattenLets [] . SD.sortDefs . dummyLet $ TcDecl.toExpr decls,
42+ -- reorder AST into strongly connected components
43+ program = SD.sortDefs . dummyLet $ TcDecl.toExpr decls,
4044 types = Map.empty,
4145 datatypes = [ (name, vars, ctors) | Datatype name vars ctors <- decls ],
4246 fixities = [ (assoc,level,op) | Fixity assoc level op <- decls ],
@@ -46,7 +50,12 @@ buildFromSource noPrelude src =
4650 }
4751
4852 types <- TI.infer metaModule
49− return $ metaModule { types = types }
53+
54+ let env = forM (Map.toList types) $ \(n,t) -> do
55+ pt <- T.extraPretty t
56+ print $ P.text n <+> P.text ":" <+> pt
57+
58+ return $ unsafePerformIO env `seq` metaModule { types = types }
5059
5160 where
5261 checkMistakes modul@(Module _ _ _ decls) =
@@ -62,17 +71,16 @@ getSortedModuleNames root =
6271type Deps = (String, [String])
6372
6473sortDeps :: [Deps] -> IO [String]
65−sortDeps deps = go [] (nub deps)
66− where
67− msg = "A cyclical or missing module dependency or was detected in: "
68−
69− go :: [String] -> [Deps] -> IO [String]
70− go sorted [] = return (map toFilePath sorted)
71− go sorted unsorted =
72− case partition (all (`elem` sorted) . snd) unsorted of
73− ([],m:ms) -> do putStrLn (msg ++ intercalate ", " (map fst (m:ms)) ++ show sorted ++ show unsorted)
74− exitFailure
75− (srtd,unsrtd) -> go (sorted ++ map fst srtd) unsrtd
74+sortDeps depends =
75+ if null mistakes
76+ then return (concat sccs)
77+ else print (msg ++ show mistakes) >> exitFailure
78+ where
79+ graph = map (\(name, deps) -> (toFilePath name, name, deps)) depends
80+ sccs = map Graph.flattenSCC $ Graph.stronglyConnComp graph
81+
82+ mistakes = filter (\scc -> length scc > 1) sccs
83+ msg = "A cyclical module dependency or was detected in: "
7684
7785readDeps :: [FilePath] -> FilePath -> IO [Deps]
7886readDeps seen root = do
@@ -86,12 +94,12 @@ readDeps seen root = do
8694 return ((name, realDeps) : concat rest)
8795 where
8896 realDeps = filter (`notElem` builtIns) deps
89− newDeps = filter (\d -> d `notElem` seen && not (isNative d)) realDeps
97+ newDeps = filter (\d -> not (d `elem` seen || isNative d)) realDeps
9098 seen' = root : seen ++ newDeps
9199 builtIns = Map.keys Libs.libraries
92100
93101
94−isNative name = takeWhile (/='.') name == "Native"
102+isNative name = List.isPrefixOf "Native." name
95103
96104toFilePath :: String -> FilePath
97105toFilePath name = map swapDots name ++ ext