git.iko.soy/elk
on master help sign in
Update Optimize.Module to produce an Opt.LocalGraph
6c3ae5bEvan Czaplicki
compiler/src/Optimize/Module.hs+31−34
compare with master
unifiedsplit
@@ -40,13 +40,13 @@ type Annotations =
40 Map.Map Name.Name Can.Annotation
40 Map.Map Name.Name Can.Annotation
41
41
42
42
43−optimize :: Annotations -> Can.Module -> Result i [W.Warning] Opt.Graph
43+optimize :: Annotations -> Can.Module -> Result i [W.Warning] Opt.LocalGraph
44optimize annotations (Can.Module home _ decls unions aliases _ effects) =
44optimize annotations (Can.Module home _ decls unions aliases _ effects) =
45 addDecls home annotations decls $
45 addDecls home annotations decls $
46 addEffects home effects $
46 addEffects home effects $
47 addUnions home unions $
47 addUnions home unions $
48 addAliases home aliases $
48 addAliases home aliases $
49− Opt.Graph Map.empty Map.empty Map.empty
49+ Opt.LocalGraph Nothing Map.empty Map.empty
50
50
51
51
52
52
@@ -57,9 +57,9 @@ type Nodes =
57 Map.Map Opt.Global Opt.Node
57 Map.Map Opt.Global Opt.Node
58
58
59
59
60−addUnions :: ModuleName.Canonical -> Map.Map Name.Name Can.Union -> Opt.Graph -> Opt.Graph
60+addUnions :: ModuleName.Canonical -> Map.Map Name.Name Can.Union -> Opt.LocalGraph -> Opt.LocalGraph
61−addUnions home unions (Opt.Graph mains nodes fields) =
61+addUnions home unions (Opt.LocalGraph main nodes fields) =
62− Opt.Graph mains (Map.foldr (addUnion home) nodes unions) fields
62+ Opt.LocalGraph main (Map.foldr (addUnion home) nodes unions) fields
63
63
64
64
65addUnion :: ModuleName.Canonical -> Can.Union -> Nodes -> Nodes
65addUnion :: ModuleName.Canonical -> Can.Union -> Nodes -> Nodes
@@ -83,13 +83,13 @@ addCtorNode home opts nodes (Can.Ctor name index numArgs _) =
83-- ALIAS
83-- ALIAS
84
84
85
85
86−addAliases :: ModuleName.Canonical -> Map.Map Name.Name Can.Alias -> Opt.Graph -> Opt.Graph
86+addAliases :: ModuleName.Canonical -> Map.Map Name.Name Can.Alias -> Opt.LocalGraph -> Opt.LocalGraph
87addAliases home aliases graph =
87addAliases home aliases graph =
88 Map.foldrWithKey (addAlias home) graph aliases
88 Map.foldrWithKey (addAlias home) graph aliases
89
89
90
90
91−addAlias :: ModuleName.Canonical -> Name.Name -> Can.Alias -> Opt.Graph -> Opt.Graph
91+addAlias :: ModuleName.Canonical -> Name.Name -> Can.Alias -> Opt.LocalGraph -> Opt.LocalGraph
92−addAlias home name (Can.Alias _ tipe) graph@(Opt.Graph mains nodes fieldCounts) =
92+addAlias home name (Can.Alias _ tipe) graph@(Opt.LocalGraph main nodes fieldCounts) =
93 case tipe of
93 case tipe of
94 Can.TRecord fields Nothing ->
94 Can.TRecord fields Nothing ->
95 let
95 let
@@ -100,8 +100,8 @@ addAlias home name (Can.Alias _ tipe) graph@(Opt.Graph mains nodes fieldCounts)
100 node =
100 node =
101 Opt.Define function Set.empty
101 Opt.Define function Set.empty
102 in
102 in
103− Opt.Graph
103+ Opt.LocalGraph
104− mains
104+ main
105 (Map.insert (Opt.Global home name) node nodes)
105 (Map.insert (Opt.Global home name) node nodes)
106 (Map.foldrWithKey addRecordCtorField fieldCounts fields)
106 (Map.foldrWithKey addRecordCtorField fieldCounts fields)
107
107
@@ -118,8 +118,8 @@ addRecordCtorField name _ fields =
118-- ADD EFFECTS
118-- ADD EFFECTS
119
119
120
120
121−addEffects :: ModuleName.Canonical -> Can.Effects -> Opt.Graph -> Opt.Graph
121+addEffects :: ModuleName.Canonical -> Can.Effects -> Opt.LocalGraph -> Opt.LocalGraph
122−addEffects home effects graph@(Opt.Graph mains nodes fields) =
122+addEffects home effects graph@(Opt.LocalGraph main nodes fields) =
123 case effects of
123 case effects of
124 Can.NoEffects ->
124 Can.NoEffects ->
125 graph
125 graph
@@ -148,10 +148,10 @@ addEffects home effects graph@(Opt.Graph mains nodes fields) =
148 Map.insert sub link $
148 Map.insert sub link $
149 Map.insert fx (Opt.Manager Opt.Fx) nodes
149 Map.insert fx (Opt.Manager Opt.Fx) nodes
150 in
150 in
151− Opt.Graph mains newNodes fields
151+ Opt.LocalGraph main newNodes fields
152
152
153
153
154−addPort :: ModuleName.Canonical -> Name.Name -> Can.Port -> Opt.Graph -> Opt.Graph
154+addPort :: ModuleName.Canonical -> Name.Name -> Can.Port -> Opt.LocalGraph -> Opt.LocalGraph
155addPort home name port_ graph =
155addPort home name port_ graph =
156 case port_ of
156 case port_ of
157 Can.Incoming _ payloadType _ ->
157 Can.Incoming _ payloadType _ ->
@@ -173,10 +173,10 @@ addPort home name port_ graph =
173-- HELPER
173-- HELPER
174
174
175
175
176−addToGraph :: Opt.Global -> Opt.Node -> Map.Map Name.Name Int -> Opt.Graph -> Opt.Graph
176+addToGraph :: Opt.Global -> Opt.Node -> Map.Map Name.Name Int -> Opt.LocalGraph -> Opt.LocalGraph
177−addToGraph name node fields (Opt.Graph mains nodes fieldCounts) =
177+addToGraph name node fields (Opt.LocalGraph main nodes fieldCounts) =
178− Opt.Graph
178+ Opt.LocalGraph
179− mains
179+ main
180 (Map.insert name node nodes)
180 (Map.insert name node nodes)
181 (Map.unionWith (+) fields fieldCounts)
181 (Map.unionWith (+) fields fieldCounts)
182
182
@@ -185,19 +185,20 @@ addToGraph name node fields (Opt.Graph mains nodes fieldCounts) =
185-- ADD DECLS
185-- ADD DECLS
186
186
187
187
188−addDecls :: ModuleName.Canonical -> Annotations -> Can.Decls -> Opt.Graph -> Result i [W.Warning] Opt.Graph
188+addDecls :: ModuleName.Canonical -> Annotations -> Can.Decls -> Opt.LocalGraph -> Result i [W.Warning] Opt.LocalGraph
189addDecls home annotations decls graph =
189addDecls home annotations decls graph =
190 case decls of
190 case decls of
191 Can.Declare def subDecls ->
191 Can.Declare def subDecls ->
192 addDecls home annotations subDecls =<< addDef home annotations def graph
192 addDecls home annotations subDecls =<< addDef home annotations def graph
193
193
194− Can.DeclareRec defs subDecls ->
194+ Can.DeclareRec d ds subDecls ->
195+ let defs = d:ds in
195 case findMain defs of
196 case findMain defs of
196 Nothing ->
197 Nothing ->
197 addDecls home annotations subDecls (addRecDefs home defs graph)
198 addDecls home annotations subDecls (addRecDefs home defs graph)
198
199
199 Just region ->
200 Just region ->
200− Result.throw $ E.BadCycle region (map defToName defs)
201+ Result.throw $ E.BadCycle region (defToName d) (map defToName ds)
201
202
202 Can.SaveTheEnvironment ->
203 Can.SaveTheEnvironment ->
203 Result.ok graph
204 Result.ok graph
@@ -229,7 +230,7 @@ defToName def =
229-- ADD DEFS
230-- ADD DEFS
230
231
231
232
232−addDef :: ModuleName.Canonical -> Annotations -> Can.Def -> Opt.Graph -> Result i [W.Warning] Opt.Graph
233+addDef :: ModuleName.Canonical -> Annotations -> Can.Def -> Opt.LocalGraph -> Result i [W.Warning] Opt.LocalGraph
233addDef home annotations def graph =
234addDef home annotations def graph =
234 case def of
235 case def of
235 Can.Def (A.At region name) args body ->
236 Can.Def (A.At region name) args body ->
@@ -241,8 +242,8 @@ addDef home annotations def graph =
241 addDefHelp region annotations home name (map fst typedArgs) body graph
242 addDefHelp region annotations home name (map fst typedArgs) body graph
242
243
243
244
244−addDefHelp :: A.Region -> Annotations -> ModuleName.Canonical -> Name.Name -> [Can.Pattern] -> Can.Expr -> Opt.Graph -> Result i w Opt.Graph
245+addDefHelp :: A.Region -> Annotations -> ModuleName.Canonical -> Name.Name -> [Can.Pattern] -> Can.Expr -> Opt.LocalGraph -> Result i w Opt.LocalGraph
245−addDefHelp region annotations home name args body graph@(Opt.Graph mains nodes fieldCounts) =
246+addDefHelp region annotations home name args body graph@(Opt.LocalGraph _ nodes fieldCounts) =
246 if name /= Name.main then
247 if name /= Name.main then
247 Result.ok (addDefNode home name args body Set.empty graph)
248 Result.ok (addDefNode home name args body Set.empty graph)
248 else
249 else
@@ -250,12 +251,8 @@ addDefHelp region annotations home name args body graph@(Opt.Graph mains nodes f
250 (Can.Forall _ tipe) = annotations ! name
251 (Can.Forall _ tipe) = annotations ! name
251
252
252 addMain (deps, fields, main) =
253 addMain (deps, fields, main) =
253− let
254− newMains = Map.insert home main mains
255− newFields = Map.unionWith (+) fields fieldCounts
256− in
257 addDefNode home name args body deps $
254 addDefNode home name args body deps $
258− Opt.Graph newMains nodes newFields
255+ Opt.LocalGraph (Just main) nodes (Map.unionWith (+) fields fieldCounts)
259 in
256 in
260 case Type.deepDealias tipe of
257 case Type.deepDealias tipe of
261 Can.TType hm nm [_] | hm == ModuleName.virtualDom && nm == Name.node ->
258 Can.TType hm nm [_] | hm == ModuleName.virtualDom && nm == Name.node ->
@@ -275,7 +272,7 @@ addDefHelp region annotations home name args body graph@(Opt.Graph mains nodes f
275 Result.throw (E.BadType region tipe)
272 Result.throw (E.BadType region tipe)
276
273
277
274
278−addDefNode :: ModuleName.Canonical -> Name.Name -> [Can.Pattern] -> Can.Expr -> Set.Set Opt.Global -> Opt.Graph -> Opt.Graph
275+addDefNode :: ModuleName.Canonical -> Name.Name -> [Can.Pattern] -> Can.Expr -> Set.Set Opt.Global -> Opt.LocalGraph -> Opt.LocalGraph
279addDefNode home name args body mainDeps graph =
276addDefNode home name args body mainDeps graph =
280 let
277 let
281 (deps, fields, def) =
278 (deps, fields, def) =
@@ -304,8 +301,8 @@ data State =
304 }
301 }
305
302
306
303
307−addRecDefs :: ModuleName.Canonical -> [Can.Def] -> Opt.Graph -> Opt.Graph
304+addRecDefs :: ModuleName.Canonical -> [Can.Def] -> Opt.LocalGraph -> Opt.LocalGraph
308−addRecDefs home defs (Opt.Graph mains nodes fieldCounts) =
305+addRecDefs home defs (Opt.LocalGraph main nodes fieldCounts) =
309 let
306 let
310 names = reverse (map toName defs)
307 names = reverse (map toName defs)
311 cycleName = Opt.Global home (Name.fromManyNames names)
308 cycleName = Opt.Global home (Name.fromManyNames names)
@@ -316,8 +313,8 @@ addRecDefs home defs (Opt.Graph mains nodes fieldCounts) =
316 Names.run $
313 Names.run $
317 foldM (addRecDef cycle) (State [] []) defs
314 foldM (addRecDef cycle) (State [] []) defs
318 in
315 in
319− Opt.Graph
316+ Opt.LocalGraph
320− mains
317+ main
321 (Map.insert cycleName (Opt.Cycle names values funcs deps) (Map.union links nodes))
318 (Map.insert cycleName (Opt.Cycle names values funcs deps) (Map.union links nodes))
322 (Map.unionWith (+) fields fieldCounts)
319 (Map.unionWith (+) fields fieldCounts)
323
320