@@ -7,21 +7,24 @@ module AST.Optimized
77 , Destructor(..)
88 , Decider(..)
99 , Choice(..)
10− , Graph(..)
10+ , GlobalGraph(..)
11+ , LocalGraph(..)
1112 , Main(..)
1213 , Node(..)
1314 , EffectsType(..)
1415 , empty
15− , union
16− , unions
16+ , addGlobalGraph
17+ , addLocalGraph
18+ , addKernel
19+ , toKernelGlobal
1720 )
1821 where
1922
2023
2124import Control.Monad (liftM, liftM2, liftM3, liftM4)
2225import Data.Binary (Binary, get, put, getWord8, putWord8)
23−import qualified Data.List as List
2426import qualified Data.Map as Map
27+import qualified Data.Name as Name
2528import Data.Name (Name)
2629import qualified Data.Set as Set
2730import qualified Data.Utf8 as Utf8
@@ -31,6 +34,7 @@ import qualified AST.Utils.Shader as Shader
3134import qualified Data.Index as Index
3235import qualified Elm.Kernel as K
3336import qualified Elm.ModuleName as ModuleName
37+import qualified Elm.Package as Pkg
3438import qualified Optimize.DecisionTree as DT
3539import qualified Reporting.Annotation as A
3640
@@ -121,11 +125,18 @@ data Choice
121125-- OBJECT GRAPH
122126
123127
124−data Graph =
125− Graph
126− { _mains :: Map.Map ModuleName.Canonical Main
127− , _nodes :: Map.Map Global Node
128− , _fields :: Map.Map Name Int
128+data GlobalGraph =
129+ GlobalGraph
130+ { _g_nodes :: Map.Map Global Node
131+ , _g_fields :: Map.Map Name Int
132+ }
133+
134+
135+data LocalGraph =
136+ LocalGraph
137+ { _l_main :: Maybe Main
138+ , _l_nodes :: Map.Map Global Node -- TODO profile switching Global to Name
139+ , _l_fields :: Map.Map Name Int
129140 }
130141
131142
@@ -159,27 +170,55 @@ data EffectsType = Cmd | Sub | Fx
159170
160171
161172{-# NOINLINE empty #-}
162−empty :: Graph
173+empty :: GlobalGraph
163174empty =
164− Graph Map.empty Map.empty Map.empty
175+ GlobalGraph Map.empty Map.empty
165176
166177
167−union :: Graph -> Graph -> Graph
168−union (Graph mains1 graph1 fields1) (Graph mains2 graph2 fields2) =
169− Graph
170− (Map.union mains1 mains2)
171− (Map.union graph1 graph2)
172− (Map.union fields1 fields2)
178+addGlobalGraph :: GlobalGraph -> GlobalGraph -> GlobalGraph
179+addGlobalGraph (GlobalGraph nodes1 fields1) (GlobalGraph nodes2 fields2) =
180+ GlobalGraph
181+ { _g_nodes = Map.union nodes1 nodes2
182+ , _g_fields = Map.union fields1 fields2
183+ }
173184
174185
175−unions :: [Graph] -> Graph
176−unions graphs =
177− case graphs of
178− [] ->
179− empty
186+addLocalGraph :: LocalGraph -> GlobalGraph -> GlobalGraph
187+addLocalGraph (LocalGraph _ nodes1 fields1) (GlobalGraph nodes2 fields2) =
188+ GlobalGraph
189+ { _g_nodes = Map.union nodes1 nodes2
190+ , _g_fields = Map.union fields1 fields2
191+ }
192+
180193
181− g:gs ->
182− List.foldl' union g gs
194+addKernel :: Name.Name -> [K.Chunk] -> GlobalGraph -> GlobalGraph
195+addKernel shortName chunks (GlobalGraph nodes fields) =
196+ let
197+ global = toKernelGlobal shortName
198+ node = Kernel chunks (foldr addKernelDep Set.empty chunks)
199+ in
200+ GlobalGraph
201+ { _g_nodes = Map.insert global node nodes
202+ , _g_fields = Map.union (K.countFields chunks) fields
203+ }
204+
205+
206+addKernelDep :: K.Chunk -> Set.Set Global -> Set.Set Global
207+addKernelDep chunk deps =
208+ case chunk of
209+ K.JS _ -> deps
210+ K.ElmVar home name -> Set.insert (Global home name) deps
211+ K.JsVar shortName _ -> Set.insert (toKernelGlobal shortName) deps
212+ K.ElmField _ -> deps
213+ K.JsField _ -> deps
214+ K.JsEnum _ -> deps
215+ K.Debug -> deps
216+ K.Prod -> deps
217+
218+
219+toKernelGlobal :: Name.Name -> Global
220+toKernelGlobal shortName =
221+ Global (ModuleName.Canonical Pkg.kernel shortName) Name.dollar
183222
184223
185224
@@ -323,9 +362,14 @@ instance Binary Choice where
323362
324363
325364
326−instance Binary Graph where
327− get = liftM3 Graph get get get
328− put (Graph a b c) = put a >> put b >> put c
365+instance Binary GlobalGraph where
366+ get = liftM2 GlobalGraph get get
367+ put (GlobalGraph a b) = put a >> put b
368+
369+
370+instance Binary LocalGraph where
371+ get = liftM3 LocalGraph get get get
372+ put (LocalGraph a b c) = put a >> put b >> put c
329373
330374
331375instance Binary Main where