git.iko.soy/elk
on 0cfae2e help sign in
elk/compiler/Initialize.hs
84 lines 2.9 kB history raw
1module Initialize (buildFromSource, getSortedModuleNames) where
3import Control.Applicative ((<$>))
4import Control.Monad.Error
5import Data.List (nub)
6import qualified Data.Map as Map
7import Data.Data
8import Data.List (intercalate,partition)
9import System.Exit
10import System.FilePath
11import Text.PrettyPrint (Doc)
13import Parse.Parser (parseProgram, parseDependencies)
14import SourceSyntax.Everything
15import qualified Metadata.Libraries as Libs
16import qualified Transform.Optimize as Optimize
17import qualified Transform.Check as Check
18import qualified Type.Inference as TI
19import qualified Type.Type as T
23checkMistakes :: (Data t, Data v) => Module t v -> Either [Doc] (Module t v)
24checkMistakes modul@(Module name ex im decls) =
25 case Check.mistakes decls of
26 [] -> return modul
27 ms -> Left ms
29-- subs `seq` return (Optimize.optimize (renameModule modul))
31buildFromSource :: (Data t, Data v) => Bool -> String -> Either [Doc] (Module t v, Map.Map String T.Variable)
32buildFromSource noPrelude src = do
33 modul <- parseProgram src
35 -- check for structural errors and give all variables unique names
36 modul' <- renameModule <$> checkMistakes modul
37 -- reorder AST into strongly connected components
39 types <- TI.infer modul'
40 return (modul', types)
42getSortedModuleNames :: FilePath -> IO [String]
43getSortedModuleNames root =
44 sortDeps =<< readDeps [] root
46type Deps = (String, [String])
48sortDeps :: [Deps] -> IO [String]
49sortDeps deps = go [] (nub deps)
50 where
51 msg = "A cyclical or missing module dependency or was detected in: "
53 go :: [String] -> [Deps] -> IO [String]
54 go sorted [] = return (map toFilePath sorted)
55 go sorted unsorted =
56 case partition (all (`elem` sorted) . snd) unsorted of
57 ([],m:ms) -> do putStrLn (msg ++ intercalate ", " (map fst (m:ms)) ++ show sorted ++ show unsorted)
58 exitFailure
59 (srtd,unsrtd) -> go (sorted ++ map fst srtd) unsrtd
61readDeps :: [FilePath] -> FilePath -> IO [Deps]
62readDeps seen root = do
63 txt <- readFile root
64 case parseDependencies txt of
65 Left err ->
66 let msg = "Error resolving dependencies in " ++ root ++ ":\n" in
67 putStrLn (msg ++ err) >> exitFailure
68 Right (name,deps) ->
69 do rest <- mapM (readDeps seen' . toFilePath) newDeps
70 return ((name, realDeps) : concat rest)
71 where
72 realDeps = filter (`notElem` builtIns) deps
73 newDeps = filter (\d -> d `notElem` seen && not (isNative d)) realDeps
74 seen' = root : seen ++ newDeps
75 builtIns = Map.keys Libs.libraries
78isNative name = takeWhile (/='.') name == "Native"
80toFilePath :: String -> FilePath
81toFilePath name = map swapDots name ++ ext
82 where swapDots '.' = '/'
83 swapDots c = c
84 ext = if isNative name then ".js" else ".elm"