git.iko.soy/elk
on master help sign in
Add binary instances for Opt.Graph / improve KChunk representation
da57d72Evan Czaplicki
src/AST/Optimized.hs+100−14
compare with master
unifiedsplit
@@ -3,12 +3,14 @@ module AST.Optimized
3 ( Def(..)
3 ( Def(..)
4 , Expr(..)
4 , Expr(..)
5 , Global(..)
5 , Global(..)
6+ , kernel
6 , Decider(..)
7 , Decider(..)
7 , Choice(..)
8 , Choice(..)
8 , Graph(..)
9 , Graph(..)
9 , Main(..)
10 , Main(..)
10 , Node(..)
11 , Node(..)
11 , EffectsType(..)
12 , EffectsType(..)
13+ , KContent(..)
12 , KChunk(..)
14 , KChunk(..)
13 )
15 )
14 where
16 where
@@ -25,6 +27,7 @@ import qualified AST.Canonical as Can
25import qualified AST.Module.Name as ModuleName
27import qualified AST.Module.Name as ModuleName
26import qualified Data.Index as Index
28import qualified Data.Index as Index
27import qualified Elm.Name as N
29import qualified Elm.Name as N
30+import qualified Elm.Package as Pkg
28import qualified Optimize.DecisionTree as DT
31import qualified Optimize.DecisionTree as DT
29import qualified Reporting.Region as R
32import qualified Reporting.Region as R
30
33
@@ -64,6 +67,13 @@ data Global = Global ModuleName.Canonical N.Name
64 deriving (Eq, Ord)
67 deriving (Eq, Ord)
65
68
66
69
70+-- Provide "List" not "Elm.Kernel.List"
71+--
72+kernel :: N.Name -> Global
73+kernel home =
74+ Global (ModuleName.Canonical Pkg.kernel home) N.dollar
75+
76+
67
77
68-- DEFINITIONS
78-- DEFINITIONS
69
79
@@ -121,7 +131,7 @@ data Node
121 | Link Global
131 | Link Global
122 | Cycle [(N.Name, Expr)] (Set.Set Global)
132 | Cycle [(N.Name, Expr)] (Set.Set Global)
123 | Manager EffectsType
133 | Manager EffectsType
124− | Kernel [KChunk] (Set.Set Global) (Maybe ([KChunk], Set.Set Global))
134+ | Kernel KContent (Maybe KContent)
125 | PortIncoming Expr (Set.Set Global)
135 | PortIncoming Expr (Set.Set Global)
126 | PortOutgoing Expr (Set.Set Global)
136 | PortOutgoing Expr (Set.Set Global)
127
137
@@ -129,9 +139,14 @@ data Node
129data EffectsType = Cmd | Sub | Fx
139data EffectsType = Cmd | Sub | Fx
130
140
131
141
142+data KContent =
143+ KContent [KChunk] (Set.Set Global)
144+
145+
132data KChunk
146data KChunk
133 = JS BS.ByteString
147 = JS BS.ByteString
148+ | ElmVar ModuleName.Canonical N.Name
134− | Var N.Name N.Name
149+ | JsVar N.Name N.Name
135 | ElmField N.Name
150 | ElmField N.Name
136 | JsField Int
151 | JsField Int
137 | Enum Int
152 | Enum Int
@@ -250,25 +265,96 @@ instance Binary Choice where
250 _ -> error "problem getting Opt.Choice binary"
265 _ -> error "problem getting Opt.Choice binary"
251
266
252
267
268+
269+instance Binary Graph where
270+ get = liftM3 Graph get get get
271+ put (Graph a b c) = put a >> put b >> put c
272+
273+
274+instance Binary Main where
275+ put main =
276+ case main of
277+ Static -> putWord8 0
278+ Dynamic a -> putWord8 1 >> put a
279+
280+ get =
281+ do word <- getWord8
282+ case word of
283+ 0 -> return Static
284+ 1 -> liftM Dynamic get
285+ _ -> error "problem getting Opt.Main binary"
286+
287+
288+instance Binary Node where
289+ put node =
290+ case node of
291+ Define a b -> putWord8 0 >> put a >> put b
292+ DefineTailFunc a b c -> putWord8 1 >> put a >> put b >> put c
293+ Ctor a b c -> putWord8 2 >> put a >> put b >> put c
294+ Link a -> putWord8 3 >> put a
295+ Cycle a b -> putWord8 4 >> put a >> put b
296+ Manager a -> putWord8 5 >> put a
297+ Kernel a b -> putWord8 6 >> put a >> put b
298+ PortIncoming a b -> putWord8 7 >> put a >> put b
299+ PortOutgoing a b -> putWord8 8 >> put a >> put b
300+
301+ get =
302+ do word <- getWord8
303+ case word of
304+ 0 -> liftM2 Define get get
305+ 1 -> liftM3 DefineTailFunc get get get
306+ 2 -> liftM3 Ctor get get get
307+ 3 -> liftM Link get
308+ 4 -> liftM2 Cycle get get
309+ 5 -> liftM Manager get
310+ 6 -> liftM2 Kernel get get
311+ 7 -> liftM2 PortIncoming get get
312+ 8 -> liftM2 PortOutgoing get get
313+ _ -> error "problem getting Opt.Node binary"
314+
315+
316+instance Binary EffectsType where
317+ put effectsType =
318+ case effectsType of
319+ Cmd -> putWord8 0
320+ Sub -> putWord8 1
321+ Fx -> putWord8 2
322+
323+ get =
324+ do word <- getWord8
325+ case word of
326+ 0 -> return Cmd
327+ 1 -> return Sub
328+ 2 -> return Fx
329+ _ -> error "problem getting Opt.EffectsType binary"
330+
331+
332+instance Binary KContent where
333+ get = liftM2 KContent get get
334+ put (KContent a b) = put a >> put b
335+
336+
253instance Binary KChunk where
337instance Binary KChunk where
254 put chunk =
338 put chunk =
255 case chunk of
339 case chunk of
256 JS a -> putWord8 0 >> put a
340 JS a -> putWord8 0 >> put a
257− Var a b -> putWord8 1 >> put a >> put b
341+ ElmVar a b -> putWord8 1 >> put a >> put b
342+ JsVar a b -> putWord8 2 >> put a >> put b
258− ElmField a -> putWord8 2 >> put a
343+ ElmField a -> putWord8 3 >> put a
259− JsField a -> putWord8 3 >> put a
344+ JsField a -> putWord8 4 >> put a
260− Enum a -> putWord8 4 >> put a
345+ Enum a -> putWord8 5 >> put a
261− Debug -> putWord8 5
346+ Debug -> putWord8 6
262− Prod -> putWord8 6
347+ Prod -> putWord8 7
263
348
264 get =
349 get =
265 do word <- getWord8
350 do word <- getWord8
266 case word of
351 case word of
267 0 -> liftM JS get
352 0 -> liftM JS get
268− 1 -> liftM2 Var get get
353+ 1 -> liftM2 ElmVar get get
269− 2 -> liftM ElmField get
354+ 2 -> liftM2 JsVar get get
270− 3 -> liftM JsField get
355+ 3 -> liftM ElmField get
356+ 4 -> liftM JsField get
271− 4 -> liftM Enum get
357+ 5 -> liftM Enum get
272− 5 -> return Debug
358+ 6 -> return Debug
273− 6 -> return Prod
359+ 7 -> return Prod
274 _ -> error "problem deserializing AST.Optimized.KChunk"
360 _ -> error "problem deserializing AST.Optimized.KChunk"