git.iko.soy/elk
on master help sign in
Track normal and kernel deps the same way
2799bc0Evan Czaplicki
src/Optimize/Module.hs+14−14
compare with master
unifiedsplit
@@ -90,7 +90,7 @@ addAlias home name (Can.Alias _ _ maybeFields) graph@(Graph fieldCounts nodes) =
90 Map.fromList $ map toPair fields
90 Map.fromList $ map toPair fields
91
91
92 node =
92 node =
93− Opt.Define function Set.empty Set.empty
93+ Opt.Define function Set.empty
94 in
94 in
95 Graph
95 Graph
96 (foldr addOne fieldCounts fields)
96 (foldr addOne fieldCounts fields)
@@ -149,15 +149,15 @@ addPort home name port_ graph =
149 case port_ of
149 case port_ of
150 Can.Incoming _ tipe ->
150 Can.Incoming _ tipe ->
151 let
151 let
152− (kernels, globals, fields, decoder) = Names.run (Port.toDecoder tipe)
152+ (deps, fields, decoder) = Names.run (Port.toDecoder tipe)
153− node = Opt.PortIncoming decoder kernels globals
153+ node = Opt.PortIncoming decoder deps
154 in
154 in
155 addToGraph (Opt.Global home name) node fields graph
155 addToGraph (Opt.Global home name) node fields graph
156
156
157 Can.Outgoing _ tipe ->
157 Can.Outgoing _ tipe ->
158 let
158 let
159− (kernels, globals, fields, encoder) = Names.run (Port.toEncoder tipe)
159+ (deps, fields, encoder) = Names.run (Port.toEncoder tipe)
160− node = Opt.PortOutgoing encoder kernels globals
160+ node = Opt.PortOutgoing encoder deps
161 in
161 in
162 addToGraph (Opt.Global home name) node fields graph
162 addToGraph (Opt.Global home name) node fields graph
163
163
@@ -198,21 +198,21 @@ addDefHelp name args body graph =
198 case args of
198 case args of
199 [] ->
199 [] ->
200 let
200 let
201− (kernels, globals, fields, value) =
201+ (deps, fields, value) =
202 Names.run (Expr.optimize Set.empty body)
202 Names.run (Expr.optimize Set.empty body)
203 in
203 in
204− addToGraph name (Opt.Define value kernels globals) fields graph
204+ addToGraph name (Opt.Define value deps) fields graph
205
205
206 _ ->
206 _ ->
207 let
207 let
208− (kernels, globals, fields, function) =
208+ (deps, fields, function) =
209 Names.run $
209 Names.run $
210 do (argNames, defss) <- Expr.destructArgs args
210 do (argNames, defss) <- Expr.destructArgs args
211 obody <- Expr.optimize Set.empty body
211 obody <- Expr.optimize Set.empty body
212 pure $ Opt.Function argNames $
212 pure $ Opt.Function argNames $
213 foldr Opt.Let obody (concat defss)
213 foldr Opt.Let obody (concat defss)
214 in
214 in
215− addToGraph name (Opt.Define function kernels globals) fields graph
215+ addToGraph name (Opt.Define function deps) fields graph
216
216
217
217
218addToGraph :: Opt.Global -> Opt.Node -> Map.Map N.Name Int -> Graph -> Graph
218addToGraph :: Opt.Global -> Opt.Node -> Map.Map N.Name Int -> Graph -> Graph
@@ -235,12 +235,12 @@ addRecDefs home defs graph =
235 dummyName =
235 dummyName =
236 Opt.Global home (N.toCompositeName cycleValues)
236 Opt.Global home (N.toCompositeName cycleValues)
237
237
238− (kernels, globals, fields, State cyclicValuePairs newGraph) =
238+ (deps, fields, State cyclicValuePairs newGraph) =
239 Names.run $
239 Names.run $
240 foldM (addRecDef home dummyName cycleValues) (State [] graph) defs
240 foldM (addRecDef home dummyName cycleValues) (State [] graph) defs
241
241
242 node =
242 node =
243− Opt.Cycle cyclicValuePairs kernels globals
243+ Opt.Cycle cyclicValuePairs deps
244 in
244 in
245 addToGraph dummyName node fields newGraph
245 addToGraph dummyName node fields newGraph
246
246
@@ -280,17 +280,17 @@ addRecDef home dummyName cycle state@(State values graph) def =
280
280
281 _ ->
281 _ ->
282 let
282 let
283− (kernels, globals, fields, odef) =
283+ (deps, fields, odef) =
284 Names.run (Expr.optimizePotentialTailCall Set.empty def)
284 Names.run (Expr.optimizePotentialTailCall Set.empty def)
285 in
285 in
286 pure $ State values $
286 pure $ State values $
287 case odef of
287 case odef of
288 Opt.Def name body ->
288 Opt.Def name body ->
289− let node = Opt.Define body kernels globals in
289+ let node = Opt.Define body deps in
290 addToGraph (Opt.Global home name) node fields graph
290 addToGraph (Opt.Global home name) node fields graph
291
291
292 Opt.TailDef name args body ->
292 Opt.TailDef name args body ->
293− let node = Opt.DefineTailFunc args body kernels globals in
293+ let node = Opt.DefineTailFunc args body deps in
294 addToGraph (Opt.Global home name) node fields graph
294 addToGraph (Opt.Global home name) node fields graph
295
295
296
296
src/Optimize/Names.hs+39−34
@@ -22,6 +22,7 @@ import qualified Data.Text as Text
22import qualified AST.Optimized as Opt
22import qualified AST.Optimized as Opt
23import qualified AST.Module.Name as ModuleName
23import qualified AST.Module.Name as ModuleName
24import qualified Elm.Name as N
24import qualified Elm.Name as N
25+import qualified Elm.Package as Pkg
25
26
26
27
27
28
@@ -32,49 +33,53 @@ newtype Tracker a =
32 Tracker (
33 Tracker (
33 forall r.
34 forall r.
34 Int
35 Int
35− -> Set.Set N.Name
36 -> Set.Set Opt.Global
36 -> Set.Set Opt.Global
37 -> Map.Map N.Name Int
37 -> Map.Map N.Name Int
38− -> (Int -> Set.Set N.Name -> Set.Set Opt.Global -> Map.Map N.Name Int -> a -> r)
38+ -> (Int -> Set.Set Opt.Global -> Map.Map N.Name Int -> a -> r)
39 -> r
39 -> r
40 )
40 )
41
41
42
42
43−run :: Tracker a -> (Set.Set N.Name, Set.Set Opt.Global, Map.Map N.Name Int, a)
43+run :: Tracker a -> (Set.Set Opt.Global, Map.Map N.Name Int, a)
44run (Tracker k) =
44run (Tracker k) =
45− k 0 Set.empty Set.empty Map.empty
45+ k 0 Set.empty Map.empty
46− (\_uid kernels globals fields value -> (kernels, globals, fields, value))
46+ (\_uid deps fields value -> (deps, fields, value))
47
47
48
48
49generate :: Tracker N.Name
49generate :: Tracker N.Name
50generate =
50generate =
51− Tracker $ \n k g f ok ->
51+ Tracker $ \uid deps fields ok ->
52− ok (n + 1) k g f ("_n" <> Text.pack (show n))
52+ ok (uid + 1) deps fields ("_n" <> Text.pack (show uid))
53
53
54
54
55registerKernel :: N.Name -> a -> Tracker a
55registerKernel :: N.Name -> a -> Tracker a
56−registerKernel name value =
56+registerKernel home value =
57− Tracker $ \n k g f ok ->
57+ Tracker $ \uid deps fields ok ->
58− ok n (Set.insert name k) g f value
58+ ok uid (Set.insert (toKernelGlobal home) deps) fields value
59+
60+
61+toKernelGlobal :: N.Name -> Opt.Global
62+toKernelGlobal home =
63+ Opt.Global (ModuleName.Canonical Pkg.kernel home) N.dollar
59
64
60
65
61registerGlobal :: ModuleName.Canonical -> N.Name -> Tracker Opt.Expr
66registerGlobal :: ModuleName.Canonical -> N.Name -> Tracker Opt.Expr
62registerGlobal home name =
67registerGlobal home name =
63− Tracker $ \n k g f ok ->
68+ Tracker $ \uid deps fields ok ->
64 let global = Opt.Global home name in
69 let global = Opt.Global home name in
65− ok n k (Set.insert global g) f (Opt.VarGlobal global)
70+ ok uid (Set.insert global deps) fields (Opt.VarGlobal global)
66
71
67
72
68registerField :: N.Name -> a -> Tracker a
73registerField :: N.Name -> a -> Tracker a
69registerField name value =
74registerField name value =
70− Tracker $ \n k g fields ok ->
75+ Tracker $ \uid d fields ok ->
71− ok n k g (Map.insertWith (+) name 1 fields) value
76+ ok uid d (Map.insertWith (+) name 1 fields) value
72
77
73
78
74registerFieldDict :: Map.Map N.Name v -> a -> Tracker a
79registerFieldDict :: Map.Map N.Name v -> a -> Tracker a
75registerFieldDict newFields value =
80registerFieldDict newFields value =
76− Tracker $ \n k g fields ok ->
81+ Tracker $ \uid d fields ok ->
77− ok n k g (Map.unionWith (+) fields (Map.map toOne newFields)) value
82+ ok uid d (Map.unionWith (+) fields (Map.map toOne newFields)) value
78
83
79
84
80toOne :: a -> Int
85toOne :: a -> Int
@@ -83,8 +88,8 @@ toOne _ = 1
83
88
84registerFieldList :: [N.Name] -> a -> Tracker a
89registerFieldList :: [N.Name] -> a -> Tracker a
85registerFieldList names value =
90registerFieldList names value =
86− Tracker $ \n k g fields ok ->
91+ Tracker $ \uid deps fields ok ->
87− ok n k g (foldr addOne fields names) value
92+ ok uid deps (foldr addOne fields names) value
88
93
89
94
90addOne :: N.Name -> Map.Map N.Name Int -> Map.Map N.Name Int
95addOne :: N.Name -> Map.Map N.Name Int -> Map.Map N.Name Int
@@ -98,40 +103,40 @@ addOne name fields =
98
103
99instance Functor Tracker where
104instance Functor Tracker where
100 fmap func (Tracker kv) =
105 fmap func (Tracker kv) =
101− Tracker $ \n k g f ok ->
106+ Tracker $ \n d f ok ->
102 let
107 let
103− ok1 n1 k1 g1 f1 value =
108+ ok1 n1 d1 f1 value =
104− ok n1 k1 g1 f1 (func value)
109+ ok n1 d1 f1 (func value)
105 in
110 in
106− kv n k g f ok1
111+ kv n d f ok1
107
112
108
113
109instance Applicative Tracker where
114instance Applicative Tracker where
110 {-# INLINE pure #-}
115 {-# INLINE pure #-}
111 pure value =
116 pure value =
112− Tracker $ \n k g f ok -> ok n k g f value
117+ Tracker $ \n d f ok -> ok n d f value
113
118
114 (<*>) (Tracker kf) (Tracker kv) =
119 (<*>) (Tracker kf) (Tracker kv) =
115− Tracker $ \n0 k0 g0 f0 ok ->
120+ Tracker $ \n d f ok ->
116 let
121 let
117− ok1 n1 k1 g1 f1 func =
122+ ok1 n1 d1 f1 func =
118 let
123 let
119− ok2 n2 k2 g2 f2 value =
124+ ok2 n2 d2 f2 value =
120− ok n2 k2 g2 f2 (func value)
125+ ok n2 d2 f2 (func value)
121 in
126 in
122− kv n1 k1 g1 f1 ok2
127+ kv n1 d1 f1 ok2
123 in
128 in
124− kf n0 k0 g0 f0 ok1
129+ kf n d f ok1
125
130
126
131
127instance Monad Tracker where
132instance Monad Tracker where
128 return = pure
133 return = pure
129
134
130− (>>=) (Tracker ka) callback =
135+ (>>=) (Tracker k) callback =
131− Tracker $ \n k g f ok ->
136+ Tracker $ \n d f ok ->
132 let
137 let
133− ok1 n1 k1 g1 f1 a =
138+ ok1 n1 d1 f1 a =
134 case callback a of
139 case callback a of
135− Tracker kb -> kb n1 k1 g1 f1 ok
140+ Tracker kb -> kb n1 d1 f1 ok
136 in
141 in
137− ka n k g f ok1
142+ k n d f ok1