git.iko.soy/elk
on master help sign in
Start tracking field name counts
966edcdEvan Czaplicki
src/Optimize.hs+10−8
compare with master
unifiedsplit
@@ -132,19 +132,20 @@ optimizeExpr (A.At region expression) =
132 Case.optimize root <$> traverse (optimizeBranch root) branches
132 Case.optimize root <$> traverse (optimizeBranch root) branches
133
133
134 Can.Accessor field ->
134 Can.Accessor field ->
135− pure (Opt.Accessor field)
135+ Names.registerField field (Opt.Accessor field)
136
136
137 Can.Access record field ->
137 Can.Access record field ->
138 do optRecord <- optimizeExpr record
138 do optRecord <- optimizeExpr record
139− pure (Opt.Access optRecord field)
139+ Names.registerField field (Opt.Access optRecord field)
140
140
141 Can.Update record updates ->
141 Can.Update record updates ->
142− Opt.Update
142+ Names.registerFields updates Opt.Update
143− <$> optimizeExpr record
143+ <*> optimizeExpr record
144 <*> traverse optimizeExpr updates
144 <*> traverse optimizeExpr updates
145
145
146 Can.Record fields ->
146 Can.Record fields ->
147+ Names.registerFields fields Opt.Record
147− Opt.Record <$> traverse optimizeExpr fields
148+ <*> traverse optimizeExpr fields
148
149
149 Can.Unit ->
150 Can.Unit ->
150 Names.registerKernel N.utils Opt.Unit
151 Names.registerKernel N.utils Opt.Unit
@@ -223,10 +224,11 @@ destructHelp root (A.At region pattern) revDefs =
223
224
224 Can.PRecord fields ->
225 Can.PRecord fields ->
225 let
226 let
226− toDef field =
227+ addFieldDef defs name =
228+ Names.registerField name $
227− Opt.Def field (Opt.Access root field)
229+ Opt.Def name (Opt.Access root name) : defs
228 in
230 in
229− pure (map toDef fields ++ revDefs)
231+ foldM addFieldDef revDefs fields
230
232
231 Can.PAlias subPattern name ->
233 Can.PAlias subPattern name ->
232 destructHelp (Opt.VarLocal name) subPattern $
234 destructHelp (Opt.VarLocal name) subPattern $
src/Optimize/Names.hs+45−25
@@ -7,11 +7,14 @@ module Optimize.Names
7 , generate
7 , generate
8 , registerKernel
8 , registerKernel
9 , registerGlobal
9 , registerGlobal
10+ , registerFields
11+ , registerField
10 )
12 )
11 where
13 where
12
14
13
15
14import Data.Monoid ((<>))
16import Data.Monoid ((<>))
17+import qualified Data.Map as Map
15import qualified Data.Set as Set
18import qualified Data.Set as Set
16import qualified Data.Text as Text
19import qualified Data.Text as Text
17
20
@@ -30,34 +33,51 @@ newtype Tracker a =
30 Int
33 Int
31 -> Set.Set N.Name
34 -> Set.Set N.Name
32 -> Set.Set Opt.Global
35 -> Set.Set Opt.Global
36+ -> Map.Map N.Name Int
33− -> (Int -> Set.Set N.Name -> Set.Set Opt.Global -> a -> r)
37+ -> (Int -> Set.Set N.Name -> Set.Set Opt.Global -> Map.Map N.Name Int -> a -> r)
34 -> r
38 -> r
35 )
39 )
36
40
37
41
38−run :: Tracker a -> (Set.Set N.Name, Set.Set Opt.Global, a)
42+run :: Tracker a -> (Set.Set N.Name, Set.Set Opt.Global, Map.Map N.Name Int, a)
39run (Tracker k) =
43run (Tracker k) =
40− k 0 Set.empty Set.empty
44+ k 0 Set.empty Set.empty Map.empty
41− (\_uid kernels globals value -> (kernels, globals, value))
45+ (\_uid kernels globals fields value -> (kernels, globals, fields, value))
42
46
43
47
44generate :: Tracker N.Name
48generate :: Tracker N.Name
45generate =
49generate =
46− Tracker $ \n k g ok ->
50+ Tracker $ \n k g f ok ->
47− ok (n + 1) k g ("_n" <> Text.pack (show n))
51+ ok (n + 1) k g f ("_n" <> Text.pack (show n))
48
52
49
53
50registerKernel :: N.Name -> a -> Tracker a
54registerKernel :: N.Name -> a -> Tracker a
51registerKernel name value =
55registerKernel name value =
52− Tracker $ \n k g ok ->
56+ Tracker $ \n k g f ok ->
53− ok n (Set.insert name k) g value
57+ ok n (Set.insert name k) g f value
54
58
55
59
56registerGlobal :: ModuleName.Canonical -> N.Name -> Tracker Opt.Expr
60registerGlobal :: ModuleName.Canonical -> N.Name -> Tracker Opt.Expr
57registerGlobal home name =
61registerGlobal home name =
58− Tracker $ \n k g ok ->
62+ Tracker $ \n k g f ok ->
59 let global = Opt.Global home name in
63 let global = Opt.Global home name in
60− ok n k (Set.insert global g) (Opt.VarGlobal global)
64+ ok n k (Set.insert global g) f (Opt.VarGlobal global)
65+
66+
67+registerField :: N.Name -> a -> Tracker a
68+registerField name value =
69+ Tracker $ \n k g fields ok ->
70+ ok n k g (Map.insertWith (+) name 1 fields) value
71+
72+
73+registerFields :: Map.Map N.Name v -> a -> Tracker a
74+registerFields newFields value =
75+ Tracker $ \n k g fields ok ->
76+ ok n k g (Map.unionWith (+) fields (Map.map toOne newFields)) value
77+
78+
79+toOne :: a -> Int
80+toOne _ = 1
61
81
62
82
63
83
@@ -66,40 +86,40 @@ registerGlobal home name =
66
86
67instance Functor Tracker where
87instance Functor Tracker where
68 fmap func (Tracker kv) =
88 fmap func (Tracker kv) =
69− Tracker $ \n k g ok ->
89+ Tracker $ \n k g f ok ->
70 let
90 let
71− ok1 n1 k1 g1 value =
91+ ok1 n1 k1 g1 f1 value =
72− ok n1 k1 g1 (func value)
92+ ok n1 k1 g1 f1 (func value)
73 in
93 in
74− kv n k g ok1
94+ kv n k g f ok1
75
95
76
96
77instance Applicative Tracker where
97instance Applicative Tracker where
78 {-# INLINE pure #-}
98 {-# INLINE pure #-}
79 pure value =
99 pure value =
80− Tracker $ \n k g ok -> ok n k g value
100+ Tracker $ \n k g f ok -> ok n k g f value
81
101
82 (<*>) (Tracker kf) (Tracker kv) =
102 (<*>) (Tracker kf) (Tracker kv) =
83− Tracker $ \n0 k0 g0 ok ->
103+ Tracker $ \n0 k0 g0 f0 ok ->
84 let
104 let
85− ok1 n1 k1 g1 func =
105+ ok1 n1 k1 g1 f1 func =
86 let
106 let
87− ok2 n2 k2 g2 value =
107+ ok2 n2 k2 g2 f2 value =
88− ok n2 k2 g2 (func value)
108+ ok n2 k2 g2 f2 (func value)
89 in
109 in
90− kv n1 k1 g1 ok2
110+ kv n1 k1 g1 f1 ok2
91 in
111 in
92− kf n0 k0 g0 ok1
112+ kf n0 k0 g0 f0 ok1
93
113
94
114
95instance Monad Tracker where
115instance Monad Tracker where
96 return = pure
116 return = pure
97
117
98 (>>=) (Tracker ka) callback =
118 (>>=) (Tracker ka) callback =
99− Tracker $ \n k g ok ->
119+ Tracker $ \n k g f ok ->
100 let
120 let
101− ok1 n1 k1 g1 a =
121+ ok1 n1 k1 g1 f1 a =
102 case callback a of
122 case callback a of
103− Tracker kb -> kb n1 k1 g1 ok
123+ Tracker kb -> kb n1 k1 g1 f1 ok
104 in
124 in
105− ka n k g ok1
125+ ka n k g f ok1