git.iko.soy/elk
on master help sign in
Move kernel chunks into AST.Optimized
579464eEvan Czaplicki
src/AST/Optimized.hs+42−5
compare with master
unifiedsplit
@@ -9,12 +9,14 @@ module AST.Optimized
9 , Main(..)
9 , Main(..)
10 , Node(..)
10 , Node(..)
11 , EffectsType(..)
11 , EffectsType(..)
12+ , KChunk(..)
12 )
13 )
13 where
14 where
14
15
15
16
16import Control.Monad (liftM, liftM2, liftM3, liftM4)
17import Control.Monad (liftM, liftM2, liftM3, liftM4)
17import Data.Binary
18import Data.Binary
19+import qualified Data.ByteString as BS
18import qualified Data.Map as Map
20import qualified Data.Map as Map
19import qualified Data.Set as Set
21import qualified Data.Set as Set
20import Data.Text (Text)
22import Data.Text (Text)
@@ -113,19 +115,30 @@ data Main
113
115
114
116
115data Node
117data Node
116− = Define Expr (Set.Set N.Name) (Set.Set Global)
118+ = Define Expr (Set.Set Global)
117− | DefineTailFunc [N.Name] Expr (Set.Set N.Name) (Set.Set Global)
119+ | DefineTailFunc [N.Name] Expr (Set.Set Global)
118 | Ctor N.Name Index.ZeroBased Int
120 | Ctor N.Name Index.ZeroBased Int
119 | Link Global
121 | Link Global
120− | Cycle [(N.Name, Expr)] (Set.Set N.Name) (Set.Set Global)
122+ | Cycle [(N.Name, Expr)] (Set.Set Global)
121− | PortIncoming Expr (Set.Set N.Name) (Set.Set Global)
122− | PortOutgoing Expr (Set.Set N.Name) (Set.Set Global)
123 | Manager EffectsType
123 | Manager EffectsType
124+ | Kernel [KChunk] (Set.Set Global) (Maybe ([KChunk], Set.Set Global))
125+ | PortIncoming Expr (Set.Set Global)
126+ | PortOutgoing Expr (Set.Set Global)
124
127
125
128
126data EffectsType = Cmd | Sub | Fx
129data EffectsType = Cmd | Sub | Fx
127
130
128
131
132+data KChunk
133+ = JS BS.ByteString
134+ | Var N.Name N.Name
135+ | ElmField N.Name
136+ | JsField Int
137+ | Enum Int
138+ | Debug
139+ | Prod
140+
141+
129
142
130-- BINARY
143-- BINARY
131
144
@@ -235,3 +248,27 @@ instance Binary Choice where
235 0 -> liftM Inline get
248 0 -> liftM Inline get
236 1 -> liftM Jump get
249 1 -> liftM Jump get
237 _ -> error "problem getting Opt.Choice binary"
250 _ -> error "problem getting Opt.Choice binary"
251+
252+
253+instance Binary KChunk where
254+ put chunk =
255+ case chunk of
256+ JS a -> putWord8 0 >> put a
257+ Var a b -> putWord8 1 >> put a >> put b
258+ ElmField a -> putWord8 2 >> put a
259+ JsField a -> putWord8 3 >> put a
260+ Enum a -> putWord8 4 >> put a
261+ Debug -> putWord8 5
262+ Prod -> putWord8 6
263+
264+ get =
265+ do word <- getWord8
266+ case word of
267+ 0 -> liftM JS get
268+ 1 -> liftM2 Var get get
269+ 2 -> liftM ElmField get
270+ 3 -> liftM JsField get
271+ 4 -> liftM Enum get
272+ 5 -> return Debug
273+ 6 -> return Prod
274+ _ -> error "problem deserializing AST.Optimized.KChunk"
src/AST/Utils/Kernel.hsdeleted−94
@@ -1,94 +0,0 @@
1−{-# OPTIONS_GHC -Wall #-}
2−module AST.Utils.Kernel
3− ( Data(..)
4− , Content(..)
5− , Chunk(..)
6− )
7− where
8−
9−
10−import Control.Monad (liftM, liftM2)
11−import Data.Binary
12−import qualified Data.ByteString as BS
13−
14−import qualified Elm.Name as N
15−
16−
17−
18−-- DATA
19−
20−
21−data Data =
22− Data
23− { _client :: Content
24− , _server :: Maybe Content
25− }
26−
27−
28−
29−-- CONTENT
30−
31−
32−data Content =
33− Content
34− { _imports :: [(N.Name, N.Name)]
35− , _chunks :: [Chunk]
36− }
37−
38−
39−
40−-- CHUNKS
41−
42−
43−data Chunk
44− = JS BS.ByteString
45− | Var N.Name N.Name
46− | ElmField N.Name
47− | JsField Int
48− | Enum Int
49− | Debug
50− | Prod
51−
52−
53−
54−-- BINARY
55−
56−
57−instance Binary Data where
58− put (Data a b) =
59− put a >> put b
60−
61− get =
62− liftM2 Data get get
63−
64−
65−instance Binary Content where
66− put (Content a b) =
67− put a >> put b
68−
69− get =
70− liftM2 Content get get
71−
72−
73−instance Binary Chunk where
74− put chunk =
75− case chunk of
76− JS a -> putWord8 0 >> put a
77− Var a b -> putWord8 1 >> put a >> put b
78− ElmField a -> putWord8 2 >> put a
79− JsField a -> putWord8 3 >> put a
80− Enum a -> putWord8 4 >> put a
81− Debug -> putWord8 5
82− Prod -> putWord8 6
83−
84− get =
85− do word <- getWord8
86− case word of
87− 0 -> liftM JS get
88− 1 -> liftM2 Var get get
89− 2 -> liftM ElmField get
90− 3 -> liftM JsField get
91− 4 -> liftM Enum get
92− 5 -> return Debug
93− 6 -> return Prod
94− _ -> error "problem deserializing Parse.Kernel.Chunk"
src/Parse/Kernel.hs+11−11
@@ -12,8 +12,8 @@ import Data.Text (Text)
12import qualified Data.Text as Text
12import qualified Data.Text as Text
13import Data.Word (Word8)
13import Data.Word (Word8)
14
14
15+import qualified AST.Optimized as Opt
15import qualified AST.Source as Src
16import qualified AST.Source as Src
16−import qualified AST.Utils.Kernel as Kernel
17import qualified AST.Module.Name as ModuleName
17import qualified AST.Module.Name as ModuleName
18import qualified Elm.Name as N
18import qualified Elm.Name as N
19import Parse.Primitives (Parser)
19import Parse.Primitives (Parser)
@@ -27,7 +27,7 @@ import qualified Reporting.Annotation as A
27-- PARSER
27-- PARSER
28
28
29
29
30−parser :: Parser Kernel.Content
30+parser :: Parser ( [(N.Name, N.Name)], [Opt.KChunk] )
31parser =
31parser =
32 do Symbol.jsMultiCommentOpen
32 do Symbol.jsMultiCommentOpen
33 Module.freshLine
33 Module.freshLine
@@ -35,25 +35,25 @@ parser =
35 Symbol.jsMultiCommentClose
35 Symbol.jsMultiCommentClose
36 let imports = Map.unions (map destructImport srcImports)
36 let imports = Map.unions (map destructImport srcImports)
37 chunks <- parserHelp imports Map.empty Map.empty []
37 chunks <- parserHelp imports Map.empty Map.empty []
38− return (Kernel.Content (Map.elems imports) chunks)
38+ return ( Map.elems imports, chunks )
39
39
40
40
41−parserHelp :: Imports -> Enums -> Fields -> [Kernel.Chunk] -> Parser [Kernel.Chunk]
41+parserHelp :: Imports -> Enums -> Fields -> [Opt.KChunk] -> Parser [Opt.KChunk]
42parserHelp imports enums fields chunks =
42parserHelp imports enums fields chunks =
43 do (javascript, maybeTag) <- K.chunk
43 do (javascript, maybeTag) <- K.chunk
44 case maybeTag of
44 case maybeTag of
45 Nothing ->
45 Nothing ->
46− return (Kernel.JS javascript : chunks)
46+ return (Opt.JS javascript : chunks)
47
47
48 Just tag ->
48 Just tag ->
49 case tag of
49 case tag of
50 K.Prod ->
50 K.Prod ->
51 parserHelp imports enums fields $
51 parserHelp imports enums fields $
52− Kernel.Prod : Kernel.JS javascript : chunks
52+ Opt.Prod : Opt.JS javascript : chunks
53
53
54 K.Debug ->
54 K.Debug ->
55 parserHelp imports enums fields $
55 parserHelp imports enums fields $
56− Kernel.Debug : Kernel.JS javascript : chunks
56+ Opt.Debug : Opt.JS javascript : chunks
57
57
58 K.Import var ->
58 K.Import var ->
59 case Map.lookup var imports of
59 case Map.lookup var imports of
@@ -62,21 +62,21 @@ parserHelp imports enums fields chunks =
62
62
63 Just (home, name) ->
63 Just (home, name) ->
64 parserHelp imports enums fields $
64 parserHelp imports enums fields $
65− Kernel.Var home name : Kernel.JS javascript : chunks
65+ Opt.Var home name : Opt.JS javascript : chunks
66
66
67 K.Enum n var ->
67 K.Enum n var ->
68 let (enum, newEnums) = lookupEnum n var enums in
68 let (enum, newEnums) = lookupEnum n var enums in
69 parserHelp imports newEnums fields $
69 parserHelp imports newEnums fields $
70− Kernel.Enum enum : Kernel.JS javascript : chunks
70+ Opt.Enum enum : Opt.JS javascript : chunks
71
71
72 K.ElmField name ->
72 K.ElmField name ->
73 parserHelp imports enums fields $
73 parserHelp imports enums fields $
74− Kernel.ElmField name : Kernel.JS javascript : chunks
74+ Opt.ElmField name : Opt.JS javascript : chunks
75
75
76 K.JsField name ->
76 K.JsField name ->
77 let (field, newFields) = lookupField name fields in
77 let (field, newFields) = lookupField name fields in
78 parserHelp imports enums newFields $
78 parserHelp imports enums newFields $
79− Kernel.JsField field : Kernel.JS javascript : chunks
79+ Opt.JsField field : Opt.JS javascript : chunks
80
80
81
81
82
82