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