git.iko.soy/elk
on master help sign in
Expose Elm.Compiler.parseKernel to grab all kernel dependencies

This means an object graph now contains all kernel information as well. This has a few implications: - The big object files for packages will be larger. - Code generation will ONLY need object files, no extra file reads. - Values needed by kernel code will be available after DCE

commit973bf001ec672854eaf2521c1326503cc3d07413 authorEvan Czaplicki <evancz@users.noreply.github.com> dateTue 16 May 2017, 18:56 (9 years ago) parent65a3af0
7 files changed+225−94
compare with master
unifiedsplit
elm-compiler.cabal+1 src/AST/Kernel.hs+59 src/Elm/Compiler.hs+22−2 src/Elm/Compiler/Objects.hs+19−1 src/Elm/Compiler/Objects/Internal.hs+20−19 src/Generate/JavaScript.hs+94−42 src/Parse/Kernel.hs+10−30
elm-compiler.cabal+1
@@ -66,6 +66,7 @@ Library
6666 AST.Expression.Optimized,
6767 AST.Expression.Source,
6868 AST.Helpers,
69+ AST.Kernel,
6970 AST.Literal,
7071 AST.Module,
7172 AST.Module.Name,
src/AST/Kernel.hsnew file+59
@@ -0,0 +1,59 @@
1+{-# OPTIONS_GHC -Wall #-}
2+module AST.Kernel
3+ ( Info(..)
4+ , Chunk(..)
5+ )
6+ where
7+
8+
9+import Control.Monad (liftM, liftM2)
10+import Data.Binary
11+import qualified Data.ByteString as BS
12+import qualified Data.Text as Text
13+
14+import qualified AST.Module.Name as ModuleName
15+
16+
17+
18+-- INFO
19+
20+
21+data Info =
22+ Info
23+ { _imports :: [(ModuleName.Raw, Text.Text)]
24+ , _chunks :: [Chunk]
25+ }
26+
27+
28+data Chunk
29+ = JS BS.ByteString
30+ | Var ModuleName.Raw Text.Text
31+
32+
33+
34+-- BINARY
35+
36+
37+instance Binary Info where
38+ put (Info imports chunks) =
39+ put imports >> put chunks
40+
41+ get =
42+ liftM2 Info get get
43+
44+
45+instance Binary Chunk where
46+ put chunk =
47+ case chunk of
48+ JS bytes ->
49+ putWord8 0 >> put bytes
50+
51+ Var home name ->
52+ putWord8 1 >> put home >> put name
53+
54+ get =
55+ do word <- getWord8
56+ case word of
57+ 0 -> liftM JS get
58+ 1 -> liftM2 Var get get
59+ _ -> error "problem deserializing Parse.Kernel.Chunk"
src/Elm/Compiler.hs+22−2
@@ -7,16 +7,17 @@ module Elm.Compiler
77 , Error, errorToDoc, errorToJson
88 , Warning, warningToDoc, warningToJson
99 , Tag(..), parseHeader
10+ , KernelInfo(..), parseKernel
1011 )
1112 where
1213
1314import qualified Data.Aeson as Json
1415import qualified Data.Map as Map
15−import qualified Data.Set as Set
1616import Data.Text (Text)
1717import qualified Data.ByteString.Builder as BS
1818import Text.PrettyPrint.ANSI.Leijen (Doc)
1919
20+import qualified AST.Kernel as Kernel (Info)
2021import qualified AST.Module as Module
2122import qualified AST.Module.Name as ModuleName
2223import qualified Compile
@@ -29,6 +30,7 @@ import qualified Elm.Docs as Docs
2930import qualified Elm.Package as Package
3031import qualified Generate.JavaScript as JS
3132import qualified Parse.Helpers as Parse (run)
33+import qualified Parse.Kernel as Kernel (parser)
3234import qualified Parse.Module as Parse (header)
3335import qualified Reporting.Annotation as A
3436import qualified Reporting.Bag as Bag
@@ -112,7 +114,7 @@ docsGen isExposed (Module.Module name info) =
112114-- CODE GENERATION
113115
114116
115−generate :: Obj.SymbolTable -> Obj.Graph -> Obj.Roots -> (Set.Set M.Canonical, BS.Builder)
117+generate :: Obj.Graph -> Obj.Roots -> BS.Builder
116118generate =
117119 JS.generate
118120
@@ -204,3 +206,21 @@ toHeaderSummary pkgName (Module.Header maybeHeaderDecl imports) =
204206 Module.Effect _ -> Effect
205207 in
206208 ( tag, Just name, dependencies )
209+
210+
211+
212+-- PARSE KERNEL
213+
214+
215+newtype KernelInfo =
216+ KernelInfo Kernel.Info
217+
218+
219+parseKernel :: Text -> Either Error KernelInfo
220+parseKernel sourceCode =
221+ case Parse.run Kernel.parser sourceCode of
222+ Right info ->
223+ Right (KernelInfo info)
224+
225+ Left err ->
226+ Left (Error (A.map Error.Syntax err))
src/Elm/Compiler/Objects.hs+19−1
@@ -3,6 +3,7 @@ module Elm.Compiler.Objects
33 ( Graph
44 , union
55 , unions
6+ , graphForPackage
67 , Roots
78 , mains
89 , value
@@ -10,4 +11,21 @@ module Elm.Compiler.Objects
1011 where
1112
1213
13−import Elm.Compiler.Objects.Internal
14+import qualified Data.Map as Map
15+
16+import qualified AST.Module.Name as ModuleName
17+import qualified Elm.Compiler as Compiler
18+import Elm.Compiler.Objects.Internal as Obj
19+
20+
21+
22+-- HELPER
23+
24+
25+graphForPackage :: Map.Map ModuleName.Raw Compiler.KernelInfo -> [Compiler.Result] -> Obj.Graph
26+graphForPackage kernels results =
27+ let
28+ kernelGraph =
29+ Obj.Graph Map.empty (Map.map (\(Compiler.KernelInfo info) -> info) kernels)
30+ in
31+ Obj.unions (kernelGraph : map Compiler._objs results)
src/Elm/Compiler/Objects/Internal.hs+20−19
@@ -15,12 +15,13 @@ module Elm.Compiler.Objects.Internal
1515
1616import Prelude hiding (lookup)
1717import Control.Arrow (first)
18−import Control.Monad (liftM, liftM2)
18+import Control.Monad (liftM2)
1919import Data.Binary
2020import qualified Data.Map as Map
2121import qualified Data.Text as Text
2222
2323import qualified AST.Expression.Optimized as Opt
24+import qualified AST.Kernel as Kernel
2425import qualified AST.Module.Name as ModuleName
2526import qualified AST.Module as Module
2627import qualified AST.Variable as Var
@@ -30,8 +31,11 @@ import qualified AST.Variable as Var
3031-- OBJECT GRAPH
3132
3233
33−newtype Graph =
34− Graph { _graph :: Map.Map Var.Global Opt.Decl }
34+data Graph =
35+ Graph
36+ { _decls :: Map.Map Var.Global Opt.Decl
37+ , _kernels :: Map.Map ModuleName.Raw Kernel.Info
38+ }
3539
3640
3741
@@ -40,18 +44,23 @@ newtype Graph =
4044
4145fromModule :: Module.Optimized -> Graph
4246fromModule (Module.Module home info) =
43− Graph $ Map.fromList $
44− map (first (Var.Global home)) (Module.program info)
47+ let
48+ decls =
49+ Map.fromList $ map (first (Var.Global home)) (Module.program info)
50+ in
51+ Graph decls Map.empty
4552
4653
4754union :: Graph -> Graph -> Graph
48−union (Graph objs1) (Graph objs2) =
49− Graph (Map.union objs1 objs2)
55+union (Graph decls1 kernels1) (Graph decls2 kernels2) =
56+ Graph (Map.union decls1 decls2) (Map.union kernels1 kernels2)
5057
5158
5259unions :: [Graph] -> Graph
5360unions graphs =
54− Graph (Map.unions (map _graph graphs))
61+ Graph
62+ (Map.unions (map _decls graphs))
63+ (Map.unions (map _kernels graphs))
5564
5665
5766
@@ -88,16 +97,8 @@ toGlobals roots =
8897
8998
9099instance Binary Graph where
91− put (Graph dict) =
92− put dict
100+ put (Graph decls kernels) =
101+ put decls >> put kernels
93102
94103 get =
95− liftM Graph get
96−
97−
98−instance Binary Symbol where
99− put (Symbol home name) =
100− put home >> put name
101−
102− get =
103− liftM2 Symbol get get
104+ liftM2 Graph get get
src/Generate/JavaScript.hs+94−42
@@ -2,7 +2,7 @@
22{-# LANGUAGE OverloadedStrings #-}
33module Generate.JavaScript (generate) where
44
5−import Prelude hiding (init)
5+import Control.Monad (foldM)
66import Data.Monoid ((<>))
77import qualified Data.List as List
88import qualified Data.Map as Map
@@ -12,13 +12,14 @@ import qualified Data.ByteString.Builder as BS
1212
1313import qualified AST.Effects as Effects
1414import qualified AST.Expression.Optimized as Opt
15+import qualified AST.Kernel as Kernel
1516import qualified AST.Module.Name as ModuleName
1617import qualified AST.Variable as Var
1718import qualified Elm.Package as Pkg
1819import qualified Elm.Compiler.Objects.Internal as Obj
19−import qualified Generate.JavaScript.Builder as JS
20−import qualified Generate.JavaScript.Effects as Effects
21−import qualified Generate.JavaScript.Expression as JS
20+import qualified Generate.JavaScript.Builder as JsBuilder
21+import qualified Generate.JavaScript.Effects as JsEffects
22+import qualified Generate.JavaScript.Expression as JsExpr
2223import qualified Generate.JavaScript.Variable as JS
2324
2425
@@ -26,84 +27,91 @@ import qualified Generate.JavaScript.Variable as JS
2627-- GENERATE JAVASCRIPT
2728
2829
29−generate :: Obj.SymbolTable -> Obj.Graph -> Obj.Roots -> (Set.Set ModuleName.Canonical, BS.Builder)
30−generate symbols (Obj.Graph graph) roots =
30+generate :: Obj.Graph -> Obj.Roots -> BS.Builder
31+generate graph roots =
3132 let
32− (State builders _ kernels effects table) =
33− List.foldl' (crawl graph) (init symbols) (Obj.toGlobals roots)
33+ (State builders _ _ effects table) =
34+ List.foldl' (crawl graph) initialState (Obj.toGlobals roots)
3435
3536 managers =
36− fst $ JS.run table (Effects.generate effects)
37−
38− javascript =
39− List.foldl' (\rest stmt -> JS.encodeUtf8 stmt <> rest) managers builders
37+ fst $ JS.run table (JsEffects.generate effects)
4038 in
41− (kernels, javascript)
39+ List.foldl' (\rest stmt -> stmt <> rest) managers builders
4240
4341
4442
45−-- DCE STATE
43+-- CRAWL STATE
4644
4745
4846data State =
4947 State
50− { _stmts :: [JS.Stmt]
51− , _seen :: Set.Set Var.Global
52− , _kernels :: Set.Set ModuleName.Canonical
48+ { _builders :: [BS.Builder]
49+ , _seenDecls :: Set.Set Var.Global
50+ , _seenKernels :: Set.Set ModuleName.Raw
5351 , _effects :: Map.Map ModuleName.Canonical Effects.ManagerType
5452 , _table :: JS.Table
5553 }
5654
5755
58−init :: Obj.SymbolTable -> State
59−init symbols =
60− State [] Set.empty Set.empty Map.empty (JS.init symbols)
61−
62−
56+initialState :: State
57+initialState =
58+ State [] Set.empty Set.empty Map.empty JS.emptyTable
6359
64−-- DEAD CODE ELIMINATION
6560
6661
67−type Graph = Map.Map Var.Global Opt.Decl
62+-- CRAWL
6863
6964
70−crawl :: Graph -> State -> Var.Global -> State
71−crawl graph state@(State js seen kernels effects table) name@(Var.Global home _) =
72− if Set.member name seen then
65+crawl :: Obj.Graph -> State -> Var.Global -> State
66+crawl graph@(Obj.Graph decls kernels) state@(State _ seenDecls seenKernels _ _) name@(Var.Global home _) =
67+ if Set.member name seenDecls then
7368 state
7469
7570 else if home == virtualDomDebug then
7671 state
7772
7873 else
79− case Map.lookup name graph of
74+ case Map.lookup name decls of
8075 Just decl ->
8176 crawlDecl graph name decl state
8277
8378 Nothing ->
84− if ModuleName.canonicalIsKernel home then
85− State js seen (Set.insert home kernels) effects table
86− else
87− error (crawlError name)
79+ let
80+ kernelModule =
81+ ModuleName._module home
82+ in
83+ if Set.member kernelModule seenKernels then
84+ state
85+ else
86+ case Map.lookup kernelModule kernels of
87+ Just info ->
88+ crawlKernel graph kernelModule info state
89+
90+ Nothing ->
91+ error (crawlError name)
92+
93+
8894
95+-- CRAWL DECL
8996
90−crawlDecl :: Graph -> Var.Global -> Opt.Decl -> State -> State
97+
98+crawlDecl :: Obj.Graph -> Var.Global -> Opt.Decl -> State -> State
9199crawlDecl graph var@(Var.Global home name) (Opt.Decl direct indirect fx body) state1 =
92100 let
93101 state2 =
94− state1 { _seen = Set.insert var (_seen state1) }
102+ state1 { _seenDecls = Set.insert var (_seenDecls state1) }
95103
96− (State stmts seen kernels effects table) =
104+ (State builders seenDecls seenKernels effects table) =
97105 Set.foldl' (crawl graph) state2 direct
98106
99107 (stmt, newTable) =
100− JS.run table (JS.generateDecl home name body)
108+ JS.run table (JsExpr.generateDecl home name body)
101109
102110 state4 =
103111 State
104− { _stmts = stmt : stmts
105− , _seen = seen
106− , _kernels = kernels
112+ { _builders = JsBuilder.stmtToBuilder stmt : builders
113+ , _seenDecls = seenDecls
114+ , _seenKernels = seenKernels
107115 , _effects = maybe id (Map.insert home) fx effects
108116 , _table = newTable
109117 }
@@ -111,13 +119,57 @@ crawlDecl graph var@(Var.Global home name) (Opt.Decl direct indirect fx body) st
111119 Set.foldl' (crawl graph) state4 indirect
112120
113121
122+
123+-- CRAWL KERNEL
124+
125+
126+crawlKernel :: Obj.Graph -> ModuleName.Raw -> Kernel.Info -> State -> State
127+crawlKernel graph name (Kernel.Info imports chunks) state1 =
128+ let
129+ state2 =
130+ state1 { _seenKernels = Set.insert name (_seenKernels state1) }
131+
132+ (State builders seenDecls seenKernels effects table) =
133+ List.foldl' (crawl graph) state2 (map toCoreGlobal imports)
134+
135+ (builder, newTable) =
136+ JS.run table (foldM chunkToBuilder mempty chunks)
137+ in
138+ State
139+ { _builders = builder : builders
140+ , _seenDecls = seenDecls
141+ , _seenKernels = seenKernels
142+ , _effects = effects
143+ , _table = newTable
144+ }
145+
146+
147+toCoreGlobal :: ( ModuleName.Raw, Text.Text ) -> Var.Global
148+toCoreGlobal (home, name) =
149+ Var.Global (ModuleName.inCore home) name
150+
151+
152+chunkToBuilder :: BS.Builder -> Kernel.Chunk -> JS.Generator BS.Builder
153+chunkToBuilder builder chunk =
154+ case chunk of
155+ Kernel.JS javascript ->
156+ return $ BS.byteString javascript <> builder
157+
158+ Kernel.Var home name ->
159+ do expr <- JS.global (Var.Global (ModuleName.inCore home) name)
160+ return $ JsBuilder.exprToBuilder expr <> builder
161+
162+
163+-- CRAWL HELPERS
164+
165+
114166crawlError :: Var.Global -> String
115167crawlError (Var.Global (ModuleName.Canonical pkg home) name) =
116168 Text.unpack $
117169 "compiler bug manifesting in Generate.JavaScript\n"
118− <> "could not find " <> Pkg.toText pkg <> " " <> ModuleName.toText home <> "." <> name <> "\n"
119− <> "please report at <https://github.com/elm-lang/elm-compiler/issues>\n"
120− <> "try to make an <http://sscce.org/> that demonstrates the issue!"
170+ <> "Could not find " <> Pkg.toText pkg <> " " <> ModuleName.toText home <> "." <> name <> "\n"
171+ <> "Please report at <https://github.com/elm-lang/elm-compiler/issues>\n"
172+ <> "Try to make an <http://sscce.org/> that demonstrates the issue!"
121173
122174
123175virtualDomDebug :: ModuleName.Canonical
src/Parse/Kernel.hs+10−30
@@ -1,18 +1,18 @@
11{-# OPTIONS_GHC -Wall #-}
22{-# LANGUAGE OverloadedStrings #-}
33module Parse.Kernel
4− ( Chunk(..)
5− , parse
4+ ( parser
65 )
76 where
87
9−import qualified Data.ByteString as BS
8+
109import qualified Data.Map as Map
1110import Data.Monoid ((<>))
1211import Data.Text (Text)
1312import qualified Data.Text as Text
1413
1514import qualified AST.Exposing as Exposing
15+import qualified AST.Kernel as Kernel
1616import qualified AST.Module as Module
1717import qualified AST.Module.Name as Module
1818import Parse.Helpers (Parser)
@@ -22,42 +22,23 @@ import qualified Reporting.Annotation as A
2222
2323
2424
25−-- PARSE
26−
27−
28−data Chunk
29− = JS BS.ByteString
30− | Var Module.Raw Text
31−
32−
33−parse :: Text -> ( [(Module.Raw, Text)], [Chunk] )
34−parse source =
35− case Parse.run parser source of
36− Left _ ->
37− error "problem parsing kernel code"
38−
39− Right answer ->
40− answer
41−
42−
43−
4425-- PARSER
4526
4627
47−parser :: Parser ( [(Module.Raw, Text)], [Chunk] )
28+parser :: Parser Kernel.Info
4829parser =
4930 do imports <- Parse.kernelHeader
5031 let table = Map.unions (map importToTable imports)
51− chunks <- parserHelp table
52− return ( Map.elems table, chunks )
32+ chunks <- parserHelp table []
33+ return (Kernel.Info (Map.elems table) chunks)
5334
5435
55−parserHelp :: Table -> Parser [Chunk]
56−parserHelp table =
36+parserHelp :: Table -> [Kernel.Chunk] -> Parser [Kernel.Chunk]
37+parserHelp table chunks =
5738 do chunk <- Parse.kernelChunk
5839 case chunk of
5940 Left js ->
60− return [JS js]
41+ return (Kernel.JS js : chunks)
6142
6243 Right (js, var) ->
6344 case Map.lookup var table of
@@ -65,8 +46,7 @@ parserHelp table =
6546 error $ show $ "could not find " <> var <> " when parsing kernel code"
6647
6748 Just (home, name) ->
68− do rest <- parserHelp table
69− return (JS js : Var home name : rest)
49+ parserHelp table (Kernel.Var home name : Kernel.JS js : chunks)
7050
7151
7252