git.iko.soy/elk
on c19ccfe help sign in
elk/compiler/Initialize.hs
94 lines 3.3 kB history raw
1module Initialize (buildFromSource, getSortedModuleNames, Interfaces) where
3import qualified Data.Map as Map
4import Data.Data
5import qualified Data.Graph as Graph
6import qualified Data.List as List
7import System.Exit
8import System.FilePath as FP
9import Text.PrettyPrint (Doc)
11import SourceSyntax.Everything
12import SourceSyntax.Type
13import qualified Parse.Parse as Parse
14import qualified Metadata.Prelude as Prelude
15import qualified Transform.Check as Check
16import qualified Transform.SortDefinitions as SD
17import qualified Type.Inference as TI
18import qualified Type.Constrain.Declaration as TcDecl
20import System.IO.Unsafe
21import SourceSyntax.PrettyPrint
23buildFromSource :: Interfaces -> String -> Either [Doc] (MetadataModule () ())
24buildFromSource interfaces source =
25 do modul@(Module _ _ _ decls') <- Parse.program source
27 -- check for structural errors
28 Module names exs ims decls <-
29 case Check.mistakes decls' of
30 [] -> return modul
31 ms -> Left ms
33 let metaModule = MetadataModule {
34 names = names,
35 path = FP.joinPath names,
36 exports = exs,
37 imports = ims,
38 -- reorder AST into strongly connected components
39 program = SD.sortDefs . dummyLet $ TcDecl.toExpr decls,
40 types = Map.empty,
41 datatypes = [ (name,vars,ctors) | Datatype name vars ctors <- decls ],
42 fixities = [ (assoc,level,op) | Fixity assoc level op <- decls ],
43 aliases = [ (name,tvs,tipe) | TypeAlias name tvs tipe <- decls ],
44 foreignImports = [ (evt,v,name,typ) | ImportEvent evt v name typ <- decls ],
45 foreignExports = [ (evt,name,typ) | ExportEvent evt name typ <- decls ]
46 }
48 types <- TI.infer interfaces metaModule
50 return $ metaModule { types = types }
53getSortedModuleNames :: FilePath -> IO [String]
54getSortedModuleNames root =
55 sortDeps =<< readDeps [] root
57type Deps = (String, [String])
59sortDeps :: [Deps] -> IO [String]
60sortDeps depends =
61 if null mistakes
62 then return (concat sccs)
63 else print msg >> mapM print mistakes >> exitFailure
64 where
65 graph = map (\(name, deps) -> (toFilePath name, name, deps)) depends
66 sccs = map Graph.flattenSCC $ Graph.stronglyConnComp graph
68 mistakes = filter (\scc -> length scc > 1) sccs
69 msg = "A cyclical module dependency or was detected in: "
71readDeps :: [FilePath] -> FilePath -> IO [Deps]
72readDeps 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 ++ ":"
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
88isNative name = List.isPrefixOf "Native." name
90toFilePath :: String -> FilePath
91toFilePath name = map swapDots name ++ ext
92 where swapDots '.' = '/'
93 swapDots c = c
94 ext = if isNative name then ".js" else ".elm"