|
|
1
|
+{-# LANGUAGE PatternSynonyms #-}
|
|
|
2
|
+
|
|
|
3
|
+-- | Utilities for efficiently and deterministically computing free variables.
|
|
|
4
|
+module GHC.Types.Var.FV (
|
|
|
5
|
+ FV( runFV, MkFV ),
|
|
|
6
|
+ BoundVars, VarSetFV, DVarSetFV, SelectiveFV,
|
|
|
7
|
+ TyCoFV, DTyCoFV,
|
|
|
8
|
+ runFVTop, runFVAcc, runTyCoVars, runTyCoVarsDSet,
|
|
|
9
|
+ runFVSelective, runFVSelectiveList, runFVSelectiveSet,
|
|
|
10
|
+ InterestingVarFun,
|
|
|
11
|
+
|
|
|
12
|
+ addBndrFV, addBndrsFV, addBndrSelectiveFV, addBndrsSelectiveFV,
|
|
|
13
|
+ emptyFV, -- or `mempty`
|
|
|
14
|
+ unionFV, -- or `mappend`
|
|
|
15
|
+ mapUnionFV
|
|
|
16
|
+ ) where
|
|
|
17
|
+
|
|
|
18
|
+import GHC.Prelude
|
|
|
19
|
+
|
|
|
20
|
+import GHC.Types.Var
|
|
|
21
|
+import GHC.Types.Var.Set
|
|
|
22
|
+
|
|
|
23
|
+import GHC.Utils.EndoOS
|
|
|
24
|
+
|
|
|
25
|
+import GHC.Exts( oneShot )
|
|
|
26
|
+import Data.Semigroup
|
|
|
27
|
+
|
|
|
28
|
+{- Note [Finding free variables]
|
|
|
29
|
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
|
|
30
|
+We have lots of different free-variable finders:
|
|
|
31
|
+ * Shallow or deep: do we include the kind of a variable occurrence
|
|
|
32
|
+ * Deterministic or non-determinstic: what kind of set is collected
|
|
|
33
|
+ * Selective or not: selective means there is a predicate that says
|
|
|
34
|
+ which variables are of interest
|
|
|
35
|
+
|
|
|
36
|
+The type (FV env set) is the result-type of a free-variable finder, e.g.
|
|
|
37
|
+ tyCoVarsOfType :: Type -> FV BoundVars VarSet
|
|
|
38
|
+
|
|
|
39
|
+Here
|
|
|
40
|
+ * `env` is an environment, which records the locally-bound varaibles
|
|
|
41
|
+ (which are not of interest since they aren't free) and optionally
|
|
|
42
|
+ the selective predicate.
|
|
|
43
|
+
|
|
|
44
|
+ * `set` is the accumulating result set
|
|
|
45
|
+
|
|
|
46
|
+The FV type is roughly
|
|
|
47
|
+
|
|
|
48
|
+ type FV env set = env -> set -> set
|
|
|
49
|
+
|
|
|
50
|
+So `tyCoVarsOfType ty` is a function that takes an environment a set-
|
|
|
51
|
+valued accumulator, and extends the set with the free vars of `ty`.
|
|
|
52
|
+See (FV1) for why we use an accumulating parameter here.
|
|
|
53
|
+
|
|
|
54
|
+However, we want to take the union of two FV values, thus
|
|
|
55
|
+ tyCoVarsOfType t1 `mappend` tyCoVarsOfType t2
|
|
|
56
|
+We do this by making `FV` an instance of `Monoid` and `Semigroup`
|
|
|
57
|
+and using `mappend`. So we use a newtype wrapper.
|
|
|
58
|
+
|
|
|
59
|
+Some important wrinkles for efficiency:
|
|
|
60
|
+
|
|
|
61
|
+(FV1) Accumulating parameter for the free variables. We could return a
|
|
|
62
|
+ VarSet, and do lots of `unionVarSet`. But it's quite a bit more efficient
|
|
|
63
|
+ to use an accumulating parameter and add free variables one at a time.
|
|
|
64
|
+
|
|
|
65
|
+ We implement this using a (GHC-specific variant of) the standard `Endo`
|
|
|
66
|
+ type. The `mappend` for `Endo` is just function composition; see
|
|
|
67
|
+ GHC.Utils.Endo
|
|
|
68
|
+
|
|
|
69
|
+ This is more efficient for two reasons:
|
|
|
70
|
+ * Doing a tree of `unionVarSet` calls is asymptotically inefficient.
|
|
|
71
|
+ * For "deep" free variables, if we have an accumulator we can see if we
|
|
|
72
|
+ have encountered this variable before; if so, we don't need to look at its
|
|
|
73
|
+ kind. See Note [Shallow and deep free variables] in GHC.Core.TyCo.FVs
|
|
|
74
|
+
|
|
|
75
|
+(FV2) Eta expansion. It's very important that, after optimisation, we end up
|
|
|
76
|
+ with an arity-3 function. Let's consider:
|
|
|
77
|
+
|
|
|
78
|
+ tyCoVarsOfType (AppTy a b) = tyCoVarsOfType a `mappend` tyCoVarsOfType b
|
|
|
79
|
+
|
|
|
80
|
+ If we aren't careful, ater inlining `mappend`, we'll end up with
|
|
|
81
|
+
|
|
|
82
|
+ tyCoVarsOfType = \ty ->
|
|
|
83
|
+ case ty of
|
|
|
84
|
+ AppTy a b -> \env acc ->
|
|
|
85
|
+ tyCoVarsOfType a env (tyCoVarsOfType env acc)
|
|
|
86
|
+
|
|
|
87
|
+ which has to create a lambda, entirely unnecessarily. On the other hand if it
|
|
|
88
|
+ is eta-expanded, we get this:
|
|
|
89
|
+
|
|
|
90
|
+ tyCoVarsOfType = \ty env acc->
|
|
|
91
|
+ case ty of
|
|
|
92
|
+ AppTy a b -> tyCoVarsOfType a env (tyCoVarsOfType env acc)
|
|
|
93
|
+
|
|
|
94
|
+ We achieve this using the "one-shot trick" described in
|
|
|
95
|
+ Note [The one-shot state monad trick] in GHC.Utils.Monad, both for the
|
|
|
96
|
+ `env` parameter (see `oneShot` call in this module), and the `acc`
|
|
|
97
|
+ accumulator (see `onShot` call in GHC.Utils.EndoOS).
|
|
|
98
|
+
|
|
|
99
|
+ See also #11146.
|
|
|
100
|
+
|
|
|
101
|
+(FV3) Avoiding thunks. The `mappend` for `Endo` is just function composition,
|
|
|
102
|
+ but we don't want to get code like
|
|
|
103
|
+ tyCoVarsOfType (AppTy a b) env acc = tyCoVarsOfType a env $ tyCoVarsOfType b env acc
|
|
|
104
|
+ because that argument is a thunk. We want to be strict in the accumulator, so we get
|
|
|
105
|
+ tyCoVarsOfType (AppTy a b) env acc = tyCoVarsOfType env a $! tyCoVarsOfType b env acc
|
|
|
106
|
+ The strictness is done by the (<>) mmthod in `EndoOS`.
|
|
|
107
|
+
|
|
|
108
|
+(FV4) Order. When computing order-deterministic free vars, we'd like to return the
|
|
|
109
|
+ variables in left-to-right order. Thus, the free vars of (a -> b -> b) should
|
|
|
110
|
+ be [a,b] not [b,a]. This matters for quantifying variables in a predictable
|
|
|
111
|
+ way.
|
|
|
112
|
+
|
|
|
113
|
+ We achieve this by
|
|
|
114
|
+ * Combining sub-expressions in the natural left-to-right way. e.g.
|
|
|
115
|
+ tyCoVarsOfType (AppTy a b) = tyCoVarsOfType a `unionFV` tyCoVarsOfType b
|
|
|
116
|
+ * Ihe EndoOS instance, make (f <> g) do (g.f), that is compose "backwards"
|
|
|
117
|
+
|
|
|
118
|
+Note [Deterministic FV]
|
|
|
119
|
+~~~~~~~~~~~~~~~~~~~~~~~
|
|
|
120
|
+When computing free variables, the order in which you get them affects
|
|
|
121
|
+the results of floating and specialization. If you use UniqFM to collect
|
|
|
122
|
+them and then turn that into a list, you get them in nondeterministic
|
|
|
123
|
+order as described in Note [Deterministic UniqFM] in GHC.Types.Unique.DFM.
|
|
|
124
|
+
|
|
|
125
|
+So we instead collect them in a `DVarSet` (deterministic VarSet).
|
|
|
126
|
+-}
|
|
|
127
|
+
|
|
|
128
|
+
|
|
|
129
|
+{- *********************************************************************
|
|
|
130
|
+* *
|
|
|
131
|
+ Free-var result type
|
|
|
132
|
+* *
|
|
|
133
|
+********************************************************************* -}
|
|
|
134
|
+
|
|
|
135
|
+type InterestingVarFun = Var -> Bool
|
|
|
136
|
+
|
|
|
137
|
+type BoundVars = TyCoVarSet
|
|
|
138
|
+
|
|
|
139
|
+type VarSetFV = FV BoundVars (EndoOS TyCoVarSet)
|
|
|
140
|
+type DVarSetFV = FV BoundVars (EndoOS DTyCoVarSet)
|
|
|
141
|
+type SelectiveFV = FV (InterestingVarFun, BoundVars) (EndoOS DVarSet)
|
|
|
142
|
+-- VarSetFV: collects a VarSet
|
|
|
143
|
+-- DVarSetFV: collects a DVarSet (deterministic)
|
|
|
144
|
+-- SelectiveFV: selectively collects a DVarSet
|
|
|
145
|
+-- Why EndoOS? See (FV1) in Note [Finding free variables]
|
|
|
146
|
+
|
|
|
147
|
+type TyCoFV = VarSetFV
|
|
|
148
|
+type DTyCoFV = DVarSetFV
|
|
|
149
|
+
|
|
|
150
|
+newtype FV env acc = MkFV' { runFV :: env -> acc }
|
|
|
151
|
+ -- Caries an environment (typically empty, or a set of in-scope variables)
|
|
|
152
|
+ -- and a composable accumulator.
|
|
|
153
|
+ --
|
|
|
154
|
+ -- NB: `acc` is usually (EndoOS something) but not always;
|
|
|
155
|
+ -- see for example GHC.Core.TyCo.FVs.afvFolder
|
|
|
156
|
+
|
|
|
157
|
+pattern MkFV :: (env -> acc) -> FV env acc
|
|
|
158
|
+{-# COMPLETE MkFV #-}
|
|
|
159
|
+pattern MkFV f <- MkFV' f
|
|
|
160
|
+ where
|
|
|
161
|
+ MkFV f = MkFV' (oneShot f)
|
|
|
162
|
+ -- oneShot: this is the core of the one-shot trick!
|
|
|
163
|
+ -- Note [The one-shot state monad trick] in GHC.Utils.Monad.
|
|
|
164
|
+
|
|
|
165
|
+instance Semigroup a => Semigroup (FV env a) where
|
|
|
166
|
+ (<>) = unionFV
|
|
|
167
|
+
|
|
|
168
|
+instance Monoid a => Monoid (FV env a) where
|
|
|
169
|
+ mempty = emptyFV
|
|
|
170
|
+
|
|
|
171
|
+emptyFV :: Monoid a => FV env a
|
|
|
172
|
+emptyFV = MkFV (\_ -> mempty)
|
|
|
173
|
+
|
|
|
174
|
+unionFV :: Semigroup a => FV env a -> FV env a -> FV env a
|
|
|
175
|
+unionFV (MkFV' f1) (MkFV' f2) = MkFV (\env -> f1 env <> f2 env)
|
|
|
176
|
+
|
|
|
177
|
+upd_bndrs_fv :: (env -> env) -> FV env a -> FV env a
|
|
|
178
|
+{-# INLINE addBndrFV #-}
|
|
|
179
|
+upd_bndrs_fv upd f = MkFV (\bvs -> runFV f $! upd bvs)
|
|
|
180
|
+ -- Strict application to avoid making a thunk
|
|
|
181
|
+
|
|
|
182
|
+addBndrFV :: TyCoVar -> FV BoundVars a -> FV BoundVars a
|
|
|
183
|
+addBndrFV tcv = upd_bndrs_fv (\bvs -> extendVarSet bvs tcv)
|
|
|
184
|
+
|
|
|
185
|
+addBndrsFV :: [Var] -> FV BoundVars a -> FV BoundVars a
|
|
|
186
|
+addBndrsFV tcvs = upd_bndrs_fv (\bvs -> extendVarSetList bvs tcvs)
|
|
|
187
|
+
|
|
|
188
|
+addBndrSelectiveFV :: TyCoVar -> FV (f, BoundVars) a -> FV (f, BoundVars) a
|
|
|
189
|
+addBndrSelectiveFV tcv
|
|
|
190
|
+ = upd_bndrs_fv (\(f,bvs) -> let !bvs' = extendVarSet bvs tcv
|
|
|
191
|
+ -- Strict let to avoid thunks
|
|
|
192
|
+ in (f,bvs'))
|
|
|
193
|
+
|
|
|
194
|
+addBndrsSelectiveFV :: [Var] -> FV (f, BoundVars) a -> FV (f, BoundVars) a
|
|
|
195
|
+addBndrsSelectiveFV bs
|
|
|
196
|
+ = upd_bndrs_fv (\(f,bvs) -> let !bvs' = extendVarSetList bvs bs
|
|
|
197
|
+ -- Strict let to avoid thunks
|
|
|
198
|
+ in (f,bvs'))
|
|
|
199
|
+
|
|
|
200
|
+mapUnionFV :: (Foldable t, Monoid acc)
|
|
|
201
|
+ => (a -> FV env acc) -> t a -> FV env acc
|
|
|
202
|
+{-# INLINE mapUnionFV #-}
|
|
|
203
|
+mapUnionFV f xs = foldr (mappend . f) mempty xs
|
|
|
204
|
+
|
|
|
205
|
+
|
|
|
206
|
+runFVTop :: FV BoundVars a -> a
|
|
|
207
|
+{-# INLINE runFVTop #-}
|
|
|
208
|
+runFVTop f = runFV f (emptyVarSet :: BoundVars)
|
|
|
209
|
+
|
|
|
210
|
+runFVAcc :: FV BoundVars (EndoOS a) -> a -> a
|
|
|
211
|
+{-# INLINE runFVAcc #-}
|
|
|
212
|
+runFVAcc f = runEndoOS (runFVTop f)
|
|
|
213
|
+
|
|
|
214
|
+runTyCoVars :: TyCoFV -> TyCoVarSet
|
|
|
215
|
+{-# INLINE runTyCoVars #-}
|
|
|
216
|
+runTyCoVars f = runFVAcc f emptyVarSet
|
|
|
217
|
+
|
|
|
218
|
+runTyCoVarsDSet :: DTyCoFV -> DTyCoVarSet
|
|
|
219
|
+{-# INLINE runTyCoVarsDSet #-}
|
|
|
220
|
+runTyCoVarsDSet f = runFVAcc f emptyDVarSet
|
|
|
221
|
+
|
|
|
222
|
+runFVSelective :: InterestingVarFun -> SelectiveFV -> DVarSet
|
|
|
223
|
+runFVSelective interesting f
|
|
|
224
|
+ = runEndoOS (runFV f (interesting, emptyVarSet)) emptyDVarSet
|
|
|
225
|
+
|
|
|
226
|
+runFVSelectiveList :: InterestingVarFun -> SelectiveFV -> [Var]
|
|
|
227
|
+runFVSelectiveList interesting f = dVarSetElems (runFVSelective interesting f)
|
|
|
228
|
+
|
|
|
229
|
+runFVSelectiveSet :: InterestingVarFun -> SelectiveFV -> VarSet
|
|
|
230
|
+runFVSelectiveSet interesting f = dVarSetToVarSet (runFVSelective interesting f) |