git.iko.soy/elk
on a5bc960 help sign in
elk/compiler/Initialize.hs
83 lines 2.9 kB history raw
1module Initialize (buildFromSource, getSortedModuleNames) where
3import Control.Applicative ((<$>))
4import Control.Monad.Error
5import Data.List (lookup,nub)
6import qualified Data.Map as Map
7import Data.Data
8import SourceSyntax.Everything
9import Data.List (intercalate,partition)
10import Parse.Parser (parseProgram, parseDependencies)
11import qualified Metadata.Libraries as Libs
12import qualified Transform.Optimize as Optimize
13import qualified Transform.Check as Check
14import System.Exit
15import System.FilePath
18unify = undefined
19hints = undefined
22checkMistakes :: (Data t, Data v) => Module t v -> Either String (Module t v)
23checkMistakes modul@(Module name ex im decls) =
24 case Check.mistakes decls of
25 [] -> return modul
26 ms -> Left (unlines ms)
28checkTypes :: (Data t, Data v) => Module t v -> Either String (Module t v)
29checkTypes modul =
30 do subs <- unify hints modul
31 subs `seq` return (Optimize.optimize (renameModule modul))
33check :: (Data t, Data v) => Module t v -> Either String (Module t v)
34check = checkMistakes >=> checkTypes
36buildFromSource :: (Data t, Data v) => Bool -> String -> Either String (Module t v)
37buildFromSource noPrelude src =
38 let add = if noPrelude then id else Libs.addPrelude in
39 (check . add) =<< parseProgram src
41getSortedModuleNames :: FilePath -> IO [String]
42getSortedModuleNames root =
43 sortDeps =<< readDeps [] root
45type Deps = (String, [String])
47sortDeps :: [Deps] -> IO [String]
48sortDeps deps = go [] (nub deps)
49 where
50 msg = "A cyclical or missing module dependency or was detected in: "
52 go :: [String] -> [Deps] -> IO [String]
53 go sorted [] = return (map toFilePath sorted)
54 go sorted unsorted =
55 case partition (all (`elem` sorted) . snd) unsorted of
56 ([],m:ms) -> do putStrLn (msg ++ intercalate ", " (map fst (m:ms)) ++ show sorted ++ show unsorted)
57 exitFailure
58 (srtd,unsrtd) -> go (sorted ++ map fst srtd) unsrtd
60readDeps :: [FilePath] -> FilePath -> IO [Deps]
61readDeps seen root = do
62 txt <- readFile root
63 case parseDependencies txt of
64 Left err ->
65 let msg = "Error resolving dependencies in " ++ root ++ ":\n" in
66 putStrLn (msg ++ err) >> exitFailure
67 Right (name,deps) ->
68 do rest <- mapM (readDeps seen' . toFilePath) newDeps
69 return ((name, realDeps) : concat rest)
70 where
71 realDeps = filter (`notElem` builtIns) deps
72 newDeps = filter (\d -> d `notElem` seen && not (isNative d)) realDeps
73 seen' = root : seen ++ newDeps
74 builtIns = Map.keys Libs.libraries
77isNative name = takeWhile (/='.') name == "Native"
79toFilePath :: String -> FilePath
80toFilePath name = map swapDots name ++ ext
81 where swapDots '.' = '/'
82 swapDots c = c
83 ext = if isNative name then ".js" else ".elm"