on master help sign in
Revamp compilation process
efe80bcEvan Czaplicki
compiler/src/Compile.hs+36−55
@@ -1,15 +1,16 @@
1{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}
1{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}
2module Compile
2module Compile
3− ( compile
3+ ( Artifacts(..)
4− , Artifacts(..)
4+ , compile
5 )
5 )
6 where
6 where
7
7
8
8
9−import qualified Data.ByteString as BS
10import qualified Data.Map as Map
9import qualified Data.Map as Map
11import qualified Data.Name as Name
10import qualified Data.Name as Name
11+import qualified Data.OneOrMore as OneOrMore
12
12
13+import qualified AST.Source as Src
13import qualified AST.Canonical as Can
14import qualified AST.Canonical as Can
14import qualified AST.Optimized as Opt
15import qualified AST.Optimized as Opt
15import qualified Canonicalize.Module as Canonicalize
16import qualified Canonicalize.Module as Canonicalize
@@ -18,11 +19,9 @@ import qualified Elm.ModuleName as ModuleName
18import qualified Elm.Package as Pkg
19import qualified Elm.Package as Pkg
19import qualified Nitpick.PatternMatches as PatternMatches
20import qualified Nitpick.PatternMatches as PatternMatches
20import qualified Optimize.Module as Optimize
21import qualified Optimize.Module as Optimize
21−import qualified Parse.Module as Parse
22−import qualified Reporting.Error as Error
22+import qualified Reporting.Error as E
23−import qualified Reporting.Render.Type.Localizer as L
24−import qualified Reporting.Result as Result
23+import qualified Reporting.Result as R
25−import qualified Reporting.Warning as Warning
24+import qualified Reporting.Warning as W
26import qualified Type.Constrain.Module as Type
25import qualified Type.Constrain.Module as Type
27import qualified Type.Solve as Type
26import qualified Type.Solve as Type
28
27
@@ -33,71 +32,53 @@ import System.IO.Unsafe (unsafePerformIO)
33-- COMPILE
32-- COMPILE
34
33
35
34
36−type Result i a =
37− Result.Result i [Warning.Warning] Error.Error a
38−
39−
40−type ImportDict =
41− Map.Map Name.Name ModuleName.Canonical
42−
43−
44data Artifacts =
35data Artifacts =
45 Artifacts
36 Artifacts
46− { _elmi :: I.Interface
37+ { _modul :: Can.Module
38+ , _types :: Map.Map Name.Name Can.Annotation
47− , _elmo :: Opt.Graph
39+ , _graph :: Opt.Graph
48 }
40 }
49
41
50
42
51−compile :: Pkg.Name -> ImportDict -> I.Interfaces -> BS.ByteString -> Result i Artifacts
43+compile :: Pkg.Name -> Map.Map ModuleName.Raw I.Interface -> Src.Module -> ([W.Warning], Either (OneOrMore.OneOrMore E.Error) Artifacts)
52−compile pkg importDict interfaces source =
44+compile pkg ifaces modul =
53− do
45+ R.run $
54− valid <- Result.mapError Error.Syntax $
46+ do canonical <- canonicalize pkg ifaces modul
55− Parse.fromByteString pkg source
47+ annotations <- typeCheck canonical
56−
48+ () <- nitpick canonical
57− canonical <- Result.mapError Error.Canonicalize $
49+ objects <- optimize annotations canonical
58− Canonicalize.canonicalize pkg importDict interfaces valid
50+ return (Artifacts canonical annotations objects)
59−
60− let localizer = L.fromModule valid -- TODO should this be strict for GC?
61−
62− annotations <-
63− runTypeInference localizer canonical
64−
65− () <-
66− exhaustivenessCheck canonical
67
51
68− graph <- Result.mapError (Error.Main localizer) $
69− Optimize.optimize annotations canonical
70
52
71− Result.ok $
72− Artifacts
73− { _elmi = I.fromModule annotations canonical
74− , _elmo = graph
75− }
76
53
54+-- PHASES
77
55
78
56
79−-- TYPE INFERENCE
57+canonicalize :: Pkg.Name -> Map.Map ModuleName.Raw I.Interface -> Src.Module -> R.Result i [W.Warning] E.Error Can.Module
58+canonicalize pkg ifaces modul =
59+ R.mapError E.Canonicalize $ Canonicalize.canonicalize pkg ifaces modul
80
60
81
61
82−runTypeInference :: L.Localizer -> Can.Module -> Result i (Map.Map Name.Name Can.Annotation)
62+typeCheck :: Can.Module -> R.Result i w E.Error (Map.Map Name.Name Can.Annotation)
83−runTypeInference localizer canonical =
63+typeCheck canonical =
84 case unsafePerformIO (Type.run =<< Type.constrain canonical) of
64 case unsafePerformIO (Type.run =<< Type.constrain canonical) of
85 Right annotations ->
65 Right annotations ->
86− Result.ok annotations
66+ R.ok annotations
87
67
88 Left errors ->
68 Left errors ->
89− Result.throw (Error.Type localizer errors)
69+ R.throw (E.Type errors)
90
70
91
71
92−
93−-- EXHAUSTIVENESS CHECK
94−
95−
96−exhaustivenessCheck :: Can.Module -> Result i ()
72+nitpick :: Can.Module -> R.Result i w E.Error ()
97−exhaustivenessCheck canonical =
73+nitpick canonical =
98 case PatternMatches.check canonical of
74 case PatternMatches.check canonical of
75+ Right () ->
76+ R.ok ()
77+
99 Left errors ->
78 Left errors ->
100− Result.throw (Error.Pattern errors)
79+ R.throw (E.Pattern errors)
101
80
102− Right () ->
81+
103− Result.ok ()
82+optimize :: Map.Map Name.Name Can.Annotation -> Can.Module -> R.Result i [W.Warning] E.Error Opt.Graph
83+optimize annotations canonical =
84+ R.mapError E.Main $ Optimize.optimize annotations canonical