@@ -1,9 +1,11 @@
11module Initialize (buildFromSource, getSortedModuleNames, Interfaces) where
22
3−import qualified Data.Map as Map
43import Data.Data
4+import Control.Monad.State
55import qualified Data.Graph as Graph
66import qualified Data.List as List
7+import qualified Data.Map as Map
8+import qualified Data.Set as Set
79import System.Exit
810import System.FilePath as FP
911import Text.PrettyPrint (Doc)
@@ -52,7 +54,7 @@ buildFromSource interfaces source =
5254
5355getSortedModuleNames :: FilePath -> IO [String]
5456getSortedModuleNames root =
55− sortDeps =<< readDeps [] root
57+ sortDeps =<< readDeps root
5658
5759type Deps = (String, [String])
5860
@@ -68,21 +70,25 @@ sortDeps depends =
6870 mistakes = filter (\scc -> length scc > 1) sccs
6971 msg = "A cyclical module dependency or was detected in: "
7072
71−readDeps :: [FilePath] -> FilePath -> IO [Deps]
72−readDeps seen root = do
73− txt <- readFile root
74− case Parse.dependencies txt of
75− Left err -> putStrLn msg >> print err >> exitFailure
76− where msg = "Error resolving dependencies in " ++ root ++ ":"
73+readDeps :: FilePath -> IO [Deps]
74+readDeps root = evalStateT (go root) Set.empty
75+ where
76+ builtIns = Set.fromList (Map.keys Prelude.interfaces)
77+
78+ go :: FilePath -> StateT (Set.Set String) IO [Deps]
79+ go root = do
80+ txt <- liftIO $ readFile root
81+ case Parse.dependencies txt of
82+ Left err -> liftIO (putStrLn msg >> print err >> exitFailure)
83+ where msg = "Error resolving dependencies in " ++ root ++ ":"
7784
78− Right (name,deps) ->
79− do rest <- mapM (readDeps seen' . toFilePath) newDeps
80− return ((name, realDeps) : concat rest)
81− where
82− realDeps = filter (`notElem` builtIns) deps
83− newDeps = filter (\d -> not (d `elem` seen || isNative d)) realDeps
84− seen' = root : seen ++ newDeps
85− builtIns = Map.keys Prelude.interfaces
85+ Right (name,deps) ->
86+ do seen <- get
87+ let realDeps = Set.difference (Set.fromList deps) builtIns
88+ newDeps = Set.difference (Set.filter (not . isNative) realDeps) seen
89+ put (Set.insert name (Set.union newDeps seen))
90+ rest <- mapM (go . toFilePath) (Set.toList newDeps)
91+ return ((name, Set.toList realDeps) : concat rest)
8692
8793
8894isNative name = List.isPrefixOf "Native." name