git.iko.soy/elk
on 08ff939 help sign in
elk/compiler/Initialize.hs
88 lines 3.0 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 Transform.Optimize
13import System.Exit
14import System.FilePath
17{-- TODO: replace with new stuff
18import Types.Hints (hints)
19import Types.Unify (unify)
20import Types.Alias (dealias, mistakes)
21--}
22mistakes = undefined
23unify = undefined
24hints = undefined
27checkMistakes :: (Data t, Data v) => Module t v -> Either String (Module t v)
28checkMistakes modul@(Module name ex im stmts) =
29 case mistakes stmts of
30 m:ms -> Left (unlines (m:ms))
31 [] -> return modul
33checkTypes :: (Data t, Data v) => Module t v -> Either String (Module t v)
34checkTypes modul =
35 do subs <- unify hints modul
36 subs `seq` return (optimize (renameModule modul))
38check :: (Data t, Data v) => Module t v -> Either String (Module t v)
39check = checkMistakes >=> checkTypes
41buildFromSource :: (Data t, Data v) => Bool -> String -> Either String (Module t v)
42buildFromSource noPrelude src =
43 let add = if noPrelude then id else Libs.addPrelude in
44 (check . add) =<< (parseProgram src)
46getSortedModuleNames :: FilePath -> IO [String]
47getSortedModuleNames root =
48 sortDeps =<< readDeps [] root
50type Deps = (String, [String])
52sortDeps :: [Deps] -> IO [String]
53sortDeps deps = go [] (nub deps)
54 where
55 msg = "A cyclical or missing module dependency or was detected in: "
57 go :: [String] -> [Deps] -> IO [String]
58 go sorted [] = return (map toFilePath sorted)
59 go sorted unsorted =
60 case partition (all (`elem` sorted) . snd) unsorted of
61 ([],m:ms) -> do putStrLn (msg ++ intercalate ", " (map fst (m:ms)) ++ show sorted ++ show unsorted)
62 exitFailure
63 (srtd,unsrtd) -> go (sorted ++ map fst srtd) unsrtd
65readDeps :: [FilePath] -> FilePath -> IO [Deps]
66readDeps seen root = do
67 txt <- readFile root
68 case parseDependencies txt of
69 Left err ->
70 let msg = "Error resolving dependencies in " ++ root ++ ":\n" in
71 putStrLn (msg ++ err) >> exitFailure
72 Right (name,deps) ->
73 do rest <- mapM (readDeps seen' . toFilePath) newDeps
74 return ((name, realDeps) : concat rest)
75 where
76 realDeps = filter (`notElem` builtIns) deps
77 newDeps = filter (\d -> d `notElem` seen && not (isNative d)) realDeps
78 seen' = root : seen ++ newDeps
79 builtIns = Map.keys Libs.libraries
82isNative name = takeWhile (/='.') name == "Native"
84toFilePath :: String -> FilePath
85toFilePath name = map swapDots name ++ ext
86 where swapDots '.' = '/'
87 swapDots c = c
88 ext = if isNative name then ".js" else ".elm"