git.iko.soy/elk
on 499e6d9 help sign in
elk/src/Compile.hs
85 lines 2.6 kB history raw
1module Compile (compile) where
3import qualified Data.Map as Map
5import qualified AST.Module as Module
6import qualified Canonicalize
7import Elm.Utils ((|>))
8import qualified Elm.Package as Package
9import qualified Nitpick.PatternMatches as Nitpick
10import qualified Nitpick.TopLevelTypes as Nitpick
11import qualified Parse.Helpers as Parse
12import qualified Parse.Parse as Parse
13import qualified Reporting.Error as Error
14import qualified Reporting.Result as Result
15import qualified Reporting.Warning as Warning
16import qualified Type.Inference as TI
19compile
20 :: Map.Map Module.Name Package.Name
21 -> Package.Name
22 -> Bool
23 -> Module.CanonicalInterfaces
24 -> String
25 -> Result.Result Warning.Warning Error.Error Module.CanonicalModule
27compile importedPackages packageName isRoot interfaces source =
28 do
29 -- determine if default imports should be added
30 -- only elm-lang/core is exempt
31 let needsDefaults =
32 not (packageName == Package.coreName)
34 let normalInterfaces =
35 unCanonicalizeInterfaces importedPackages interfaces
37 -- Parse the source code
38 validModule <-
39 Result.mapError Error.Syntax $
40 Parse.program needsDefaults isRoot (getOpTable interfaces) source
42 -- Canonicalize all variables, pinning down where they came from.
43 canonicalModule <-
44 Canonicalize.module' normalInterfaces validModule
46 -- Run type inference on the program.
47 types <-
48 Result.from Error.Type $
49 TI.infer interfaces canonicalModule
51 -- One last round of checks
52 Result.mapError Error.Type $
53 Nitpick.topLevelTypes types (Module.body validModule)
55 Nitpick.patternMatches normalInterfaces canonicalModule
57 -- Add the real list of types
58 let body = (Module.body canonicalModule) { Module.types = types }
60 return $ canonicalModule { Module.body = body }
63getOpTable :: Module.CanonicalInterfaces -> Parse.OpTable
64getOpTable interfaces =
65 Map.elems interfaces
66 |> concatMap Module.iFixities
67 |> map (\(assoc,lvl,op) -> (op,(lvl,assoc)))
68 |> Map.fromList
71unCanonicalizeInterfaces
72 :: Map.Map Module.Name Package.Name
73 -> Module.CanonicalInterfaces
74 -> Module.Interfaces
75unCanonicalizeInterfaces packageInfo ifaces =
76 let
77 foldFun canonName iface mapSoFar =
78 case Map.lookup (Module.canonModul canonName) packageInfo of
79 Just pkg | pkg == (error "TODO iface pkg") ->
80 Map.insert (Module.canonModul canonName) iface mapSoFar
82 _ ->
83 mapSoFar
84 in
85 Map.foldrWithKey foldFun Map.empty ifaces