on 2e099f9 help sign in
elk/src/Compile.hs
82 lines 2.2 kB history raw
1{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}
2module Compile
3 ( compile
4 )
5 where
8import qualified Data.ByteString as BS
9import qualified Data.Map as Map
11import qualified AST.Canonical as Can
12import qualified AST.Optimized as Opt
13import qualified AST.Module.Name as ModuleName
14import qualified Canonicalize.Module as Canonicalize
15import qualified Elm.Interface as I
16import qualified Elm.Name as N
17import qualified Elm.Package as Pkg
18import qualified Nitpick.PatternMatches as PatternMatches
19import qualified Nitpick.TopLevelTypes as TopLevelTypes
20import qualified Optimize.Module as Optimize
21import qualified Parse.Parse as Parse
22import qualified Reporting.Error as Error
23import qualified Reporting.Result as Result
24import qualified Reporting.Warning as Warning
25import qualified Type.Constrain.Module as Type
26import qualified Type.Solve as Type
28import System.IO.Unsafe (unsafePerformIO)
32-- COMPILE
35type Result i a =
36 Result.Result i [Warning.Warning] Error.Error a
39type ImportDict =
40 Map.Map N.Name ModuleName.Canonical
43compile :: Pkg.Name -> ImportDict -> I.Interfaces -> BS.ByteString -> Result i (I.Interface, Opt.Graph)
44compile pkg importDict interfaces source =
45 do
46 valid <- Result.mapError Error.Syntax $
47 Parse.program source
49 canonical <- Result.mapError Error.Canonicalize $
50 Canonicalize.canonicalize pkg importDict interfaces valid
52 types <-
53 runTypeInference canonical
55 mains <- Result.mapError Error.Main $
56 TopLevelTypes.check types canonical
58 () <- exhaustivenessCheck canonical
60 let (Optimize.Graph fields graph) = Optimize.optimize canonical
62 Result.ok (I.fromModule types canonical, Opt.Graph mains graph fields)
65runTypeInference :: Can.Module -> Result i (Map.Map N.Name Can.Annotation)
66runTypeInference canonical =
67 case unsafePerformIO (Type.run =<< Type.constrain canonical) of
68 Left errors ->
69 Result.throw (Error.Type errors)
71 Right annotations ->
72 Result.ok annotations
75exhaustivenessCheck :: Can.Module -> Result i ()
76exhaustivenessCheck canonical =
77 case PatternMatches.check canonical of
78 Left errors ->
79 Result.throw (Error.Pattern errors)
81 Right () ->
82 Result.ok ()