git.iko.soy/elk
on 4eaeee5 help sign in
elk/src/Compile.hs
83 lines 2.3 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 annotations <-
53 runTypeInference canonical
55 mains <- Result.mapError Error.Main $
56 TopLevelTypes.check annotations canonical
58 () <-
59 exhaustivenessCheck canonical
61 let (Optimize.Graph fields graph) = Optimize.optimize canonical
63 Result.ok (I.fromModule annotations canonical, Opt.Graph mains graph fields)
66runTypeInference :: Can.Module -> Result i (Map.Map N.Name Can.Annotation)
67runTypeInference canonical =
68 case unsafePerformIO (Type.run =<< Type.constrain canonical) of
69 Left errors ->
70 Result.throw (Error.Type errors)
72 Right annotations ->
73 Result.ok annotations
76exhaustivenessCheck :: Can.Module -> Result i ()
77exhaustivenessCheck canonical =
78 case PatternMatches.check canonical of
79 Left errors ->
80 Result.throw (Error.Pattern errors)
82 Right () ->
83 Result.ok ()