git.iko.soy/elk
on cd8ade6 help sign in
elk/compiler/Initialize.hs
107 lines 4.1 kB history raw
1module Initialize (buildFromSource, getSortedDependencies) 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 qualified SourceSyntax.Type as 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
21import qualified Transform.Canonicalize as Canonical
23buildFromSource :: Bool -> Interfaces -> String -> Either [Doc] (MetadataModule () ())
24buildFromSource noPrelude interfaces source =
25 do let add = if noPrelude then id else Prelude.add
26 modul@(Module _ _ _ decls') <- add `fmap` Parse.program source
28 -- check for structural errors
29 Module names exs ims decls <-
30 case Check.mistakes decls' of
31 [] -> return modul
32 ms -> Left ms
34 let exports'
35 | null exs =
36 let get = Set.toList . SD.boundVars in
37 concat [ get pattern | Definition (Def pattern _) <- decls ] ++
38 concat [ map fst ctors | Datatype _ _ ctors <- decls ] ++
39 [ name | TypeAlias name _ (Type.Record _ _) <- decls ]
40 | otherwise = exs
42 metaModule <- Canonical.metadataModule interfaces $ MetadataModule {
43 names = names,
44 path = FP.joinPath names,
45 exports = exports',
46 imports = ims,
47 -- reorder AST into strongly connected components
48 program = SD.sortDefs . dummyLet $ TcDecl.toExpr decls,
49 types = Map.empty,
50 datatypes = [ (name,vars,ctors) | Datatype name vars ctors <- decls ],
51 fixities = [ (assoc,level,op) | Fixity assoc level op <- decls ],
52 aliases = [ (name,tvs,tipe) | TypeAlias name tvs tipe <- decls ],
53 foreignImports = [ (evt,v,name,typ) | ImportEvent evt v name typ <- decls ],
54 foreignExports = [ (evt,name,typ) | ExportEvent evt name typ <- decls ]
55 }
57 types <- TI.infer interfaces metaModule
59 return $ metaModule { types = types }
62getSortedDependencies :: Bool -> FilePath -> IO [String]
63getSortedDependencies noPrelude root =
64 sortDeps =<< readDeps noPrelude root
66type Deps = (FilePath, String, [String])
68sortDeps :: [Deps] -> IO [String]
69sortDeps depends =
70 if null mistakes
71 then return (concat sccs)
72 else print msg >> mapM print mistakes >> exitFailure
73 where
74 sccs = map Graph.flattenSCC $ Graph.stronglyConnComp depends
76 mistakes = filter (\scc -> length scc > 1) sccs
77 msg = "A cyclical module dependency or was detected in: "
79readDeps :: Bool -> FilePath -> IO [Deps]
80readDeps noPrelude root = evalStateT (go root) Set.empty
81 where
82 builtIns = if noPrelude then Set.empty
83 else Set.fromList (Map.keys Prelude.interfaces)
85 go :: FilePath -> StateT (Set.Set String) IO [Deps]
86 go root = do
87 txt <- liftIO $ readFile root
88 case Parse.dependencies txt of
89 Left err -> liftIO (putStrLn msg >> print err >> exitFailure)
90 where msg = "Error resolving dependencies in " ++ root ++ ":"
92 Right (name,deps) ->
93 do seen <- get
94 let realDeps = Set.difference (Set.fromList deps) builtIns
95 newDeps = Set.difference (Set.filter (not . isNative) realDeps) seen
96 put (Set.insert name (Set.union newDeps seen))
97 rest <- mapM (go . toFilePath) (Set.toList newDeps)
98 return ((makeRelative "." root, name, Set.toList realDeps) : concat rest)
101isNative name = List.isPrefixOf "Native." name
103toFilePath :: String -> FilePath
104toFilePath name = map swapDots name ++ ext
105 where swapDots '.' = '/'
106 swapDots c = c
107 ext = if isNative name then ".js" else ".elm"