on 3f6ffc3 help sign in
elk/src/Compile.hs
79 lines 2.5 kB history raw
1{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}
2module Compile (compile) where
4import Data.Text (Text)
6import qualified AST.Expression.Canonical as Can
7import qualified AST.Module as Module
8import qualified AST.Module.Name as ModuleName
9import qualified Canonicalize
10import qualified Elm.Package as Package
11import qualified Nitpick.PatternMatches as Nitpick
12import qualified Nitpick.TopLevelTypes as Nitpick
13import qualified Optimize
14import qualified Parse.Parse as Parse (program)
15import qualified Reporting.Error as Error
16import qualified Reporting.Render.Type as RenderType
17import qualified Reporting.Result as Result
18import qualified Reporting.Warning as Warning
19import qualified Type.Inference as TI
23-- COMPILE
26type Result =
27 Result.Result (Result.One RenderType.Localizer) Warning.Warning Error.Error
30compile
31 :: Package.Name
32 -> [ModuleName.Canonical]
33 -> Module.Interfaces
34 -> Text
35 -> Result Module.Optimized
36compile packageName canonicalImports interfaces source =
37 do
38 -- Parse the source code
39 validModule <-
40 Result.format Error.Syntax $
41 {-# SCC elm_compiler_parse #-}
42 Parse.program packageName source
44 -- Canonicalize all variables, pinning down where they came from.
45 canonicalModule <-
46 {-# SCC elm_compiler_canonicalize #-}
47 Canonicalize.module' canonicalImports interfaces validModule
49 -- Run type inference on the program.
50 types <-
51 Result.from Error.Type $
52 {-# SCC elm_compiler_types #-}
53 TI.infer interfaces canonicalModule
55 -- One last round of checks
56 canonicalDefs <-
57 Result.format Error.Type $
58 {-# SCC elm_compiler_nitpick #-}
59 Nitpick.topLevelTypes types $
60 Can.toSortedDefs (Module.program (Module.info canonicalModule))
62 tagDict <-
63 Result.format Error.Pattern $
64 {-# SCC elm_compiler_exhaustiveness #-}
65 Nitpick.patternMatches interfaces canonicalModule
67 -- Do some basic optimizations
68 let optimisedDefs =
69 {-# SCC elm_compiler_optimization #-}
70 Optimize.optimize tagDict (Module.name canonicalModule) canonicalDefs
72 -- Add the real list of types
73 let info =
74 (Module.info canonicalModule)
75 { Module.types = types
76 , Module.program = optimisedDefs
77 }
79 return $ canonicalModule { Module.info = info }