Fix #13391 by checking for kind-GADTs
[ghc.git] / compiler / basicTypes / VarSet.hs
1 {-
2 (c) The University of Glasgow 2006
3 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 -}
5
6 {-# LANGUAGE CPP #-}
7
8 module VarSet (
9 -- * Var, Id and TyVar set types
10 VarSet, IdSet, TyVarSet, CoVarSet, TyCoVarSet,
11
12 -- ** Manipulating these sets
13 emptyVarSet, unitVarSet, mkVarSet,
14 extendVarSet, extendVarSetList,
15 elemVarSet, subVarSet,
16 unionVarSet, unionVarSets, mapUnionVarSet,
17 intersectVarSet, intersectsVarSet, disjointVarSet,
18 isEmptyVarSet, delVarSet, delVarSetList, delVarSetByKey,
19 minusVarSet, filterVarSet, mapVarSet,
20 anyVarSet, allVarSet,
21 transCloVarSet, fixVarSet,
22 lookupVarSet_Directly, lookupVarSet, lookupVarSetByName,
23 sizeVarSet, seqVarSet,
24 elemVarSetByKey, partitionVarSet,
25 pluralVarSet, pprVarSet,
26
27 -- * Deterministic Var set types
28 DVarSet, DIdSet, DTyVarSet, DTyCoVarSet,
29
30 -- ** Manipulating these sets
31 emptyDVarSet, unitDVarSet, mkDVarSet,
32 extendDVarSet, extendDVarSetList,
33 elemDVarSet, dVarSetElems, subDVarSet,
34 unionDVarSet, unionDVarSets, mapUnionDVarSet,
35 intersectDVarSet, dVarSetIntersectVarSet,
36 intersectsDVarSet, disjointDVarSet,
37 isEmptyDVarSet, delDVarSet, delDVarSetList,
38 minusDVarSet, foldDVarSet, filterDVarSet,
39 dVarSetMinusVarSet, anyDVarSet, allDVarSet,
40 transCloDVarSet,
41 sizeDVarSet, seqDVarSet,
42 partitionDVarSet,
43 dVarSetToVarSet,
44 ) where
45
46 #include "HsVersions.h"
47
48 import GhcPrelude
49
50 import Var ( Var, TyVar, CoVar, TyCoVar, Id )
51 import Unique
52 import Name ( Name )
53 import UniqSet
54 import UniqDSet
55 import UniqFM( disjointUFM, pluralUFM, pprUFM )
56 import UniqDFM( disjointUDFM, udfmToUfm, anyUDFM, allUDFM )
57 import Outputable (SDoc)
58
59 -- | A non-deterministic Variable Set
60 --
61 -- A non-deterministic set of variables.
62 -- See Note [Deterministic UniqFM] in UniqDFM for explanation why it's not
63 -- deterministic and why it matters. Use DVarSet if the set eventually
64 -- gets converted into a list or folded over in a way where the order
65 -- changes the generated code, for example when abstracting variables.
66 type VarSet = UniqSet Var
67
68 -- | Identifier Set
69 type IdSet = UniqSet Id
70
71 -- | Type Variable Set
72 type TyVarSet = UniqSet TyVar
73
74 -- | Coercion Variable Set
75 type CoVarSet = UniqSet CoVar
76
77 -- | Type or Coercion Variable Set
78 type TyCoVarSet = UniqSet TyCoVar
79
80 emptyVarSet :: VarSet
81 intersectVarSet :: VarSet -> VarSet -> VarSet
82 unionVarSet :: VarSet -> VarSet -> VarSet
83 unionVarSets :: [VarSet] -> VarSet
84
85 mapUnionVarSet :: (a -> VarSet) -> [a] -> VarSet
86 -- ^ map the function over the list, and union the results
87
88 unitVarSet :: Var -> VarSet
89 extendVarSet :: VarSet -> Var -> VarSet
90 extendVarSetList:: VarSet -> [Var] -> VarSet
91 elemVarSet :: Var -> VarSet -> Bool
92 delVarSet :: VarSet -> Var -> VarSet
93 delVarSetList :: VarSet -> [Var] -> VarSet
94 minusVarSet :: VarSet -> VarSet -> VarSet
95 isEmptyVarSet :: VarSet -> Bool
96 mkVarSet :: [Var] -> VarSet
97 lookupVarSet_Directly :: VarSet -> Unique -> Maybe Var
98 lookupVarSet :: VarSet -> Var -> Maybe Var
99 -- Returns the set element, which may be
100 -- (==) to the argument, but not the same as
101 lookupVarSetByName :: VarSet -> Name -> Maybe Var
102 sizeVarSet :: VarSet -> Int
103 filterVarSet :: (Var -> Bool) -> VarSet -> VarSet
104
105 delVarSetByKey :: VarSet -> Unique -> VarSet
106 elemVarSetByKey :: Unique -> VarSet -> Bool
107 partitionVarSet :: (Var -> Bool) -> VarSet -> (VarSet, VarSet)
108
109 emptyVarSet = emptyUniqSet
110 unitVarSet = unitUniqSet
111 extendVarSet = addOneToUniqSet
112 extendVarSetList= addListToUniqSet
113 intersectVarSet = intersectUniqSets
114
115 intersectsVarSet:: VarSet -> VarSet -> Bool -- True if non-empty intersection
116 disjointVarSet :: VarSet -> VarSet -> Bool -- True if empty intersection
117 subVarSet :: VarSet -> VarSet -> Bool -- True if first arg is subset of second
118 -- (s1 `intersectsVarSet` s2) doesn't compute s2 if s1 is empty;
119 -- ditto disjointVarSet, subVarSet
120
121 unionVarSet = unionUniqSets
122 unionVarSets = unionManyUniqSets
123 elemVarSet = elementOfUniqSet
124 minusVarSet = minusUniqSet
125 delVarSet = delOneFromUniqSet
126 delVarSetList = delListFromUniqSet
127 isEmptyVarSet = isEmptyUniqSet
128 mkVarSet = mkUniqSet
129 lookupVarSet_Directly = lookupUniqSet_Directly
130 lookupVarSet = lookupUniqSet
131 lookupVarSetByName = lookupUniqSet
132 sizeVarSet = sizeUniqSet
133 filterVarSet = filterUniqSet
134 delVarSetByKey = delOneFromUniqSet_Directly
135 elemVarSetByKey = elemUniqSet_Directly
136 partitionVarSet = partitionUniqSet
137
138 mapUnionVarSet get_set xs = foldr (unionVarSet . get_set) emptyVarSet xs
139
140 -- See comments with type signatures
141 intersectsVarSet s1 s2 = not (s1 `disjointVarSet` s2)
142 disjointVarSet s1 s2 = disjointUFM (getUniqSet s1) (getUniqSet s2)
143 subVarSet s1 s2 = isEmptyVarSet (s1 `minusVarSet` s2)
144
145 anyVarSet :: (Var -> Bool) -> VarSet -> Bool
146 anyVarSet = uniqSetAny
147
148 allVarSet :: (Var -> Bool) -> VarSet -> Bool
149 allVarSet = uniqSetAll
150
151 mapVarSet :: Uniquable b => (a -> b) -> UniqSet a -> UniqSet b
152 mapVarSet = mapUniqSet
153
154 fixVarSet :: (VarSet -> VarSet) -- Map the current set to a new set
155 -> VarSet -> VarSet
156 -- (fixVarSet f s) repeatedly applies f to the set s,
157 -- until it reaches a fixed point.
158 fixVarSet fn vars
159 | new_vars `subVarSet` vars = vars
160 | otherwise = fixVarSet fn new_vars
161 where
162 new_vars = fn vars
163
164 transCloVarSet :: (VarSet -> VarSet)
165 -- Map some variables in the set to
166 -- extra variables that should be in it
167 -> VarSet -> VarSet
168 -- (transCloVarSet f s) repeatedly applies f to new candidates, adding any
169 -- new variables to s that it finds thereby, until it reaches a fixed point.
170 --
171 -- The function fn could be (Var -> VarSet), but we use (VarSet -> VarSet)
172 -- for efficiency, so that the test can be batched up.
173 -- It's essential that fn will work fine if given new candidates
174 -- one at at time; ie fn {v1,v2} = fn v1 `union` fn v2
175 -- Use fixVarSet if the function needs to see the whole set all at once
176 transCloVarSet fn seeds
177 = go seeds seeds
178 where
179 go :: VarSet -- Accumulating result
180 -> VarSet -- Work-list; un-processed subset of accumulating result
181 -> VarSet
182 -- Specification: go acc vs = acc `union` transClo fn vs
183
184 go acc candidates
185 | isEmptyVarSet new_vs = acc
186 | otherwise = go (acc `unionVarSet` new_vs) new_vs
187 where
188 new_vs = fn candidates `minusVarSet` acc
189
190 seqVarSet :: VarSet -> ()
191 seqVarSet s = sizeVarSet s `seq` ()
192
193 -- | Determines the pluralisation suffix appropriate for the length of a set
194 -- in the same way that plural from Outputable does for lists.
195 pluralVarSet :: VarSet -> SDoc
196 pluralVarSet = pluralUFM . getUniqSet
197
198 -- | Pretty-print a non-deterministic set.
199 -- The order of variables is non-deterministic and for pretty-printing that
200 -- shouldn't be a problem.
201 -- Having this function helps contain the non-determinism created with
202 -- nonDetEltsUFM.
203 -- Passing a list to the pretty-printing function allows the caller
204 -- to decide on the order of Vars (eg. toposort them) without them having
205 -- to use nonDetEltsUFM at the call site. This prevents from let-binding
206 -- non-deterministically ordered lists and reusing them where determinism
207 -- matters.
208 pprVarSet :: VarSet -- ^ The things to be pretty printed
209 -> ([Var] -> SDoc) -- ^ The pretty printing function to use on the
210 -- elements
211 -> SDoc -- ^ 'SDoc' where the things have been pretty
212 -- printed
213 pprVarSet = pprUFM . getUniqSet
214
215 -- Deterministic VarSet
216 -- See Note [Deterministic UniqFM] in UniqDFM for explanation why we need
217 -- DVarSet.
218
219 -- | Deterministic Variable Set
220 type DVarSet = UniqDSet Var
221
222 -- | Deterministic Identifier Set
223 type DIdSet = UniqDSet Id
224
225 -- | Deterministic Type Variable Set
226 type DTyVarSet = UniqDSet TyVar
227
228 -- | Deterministic Type or Coercion Variable Set
229 type DTyCoVarSet = UniqDSet TyCoVar
230
231 emptyDVarSet :: DVarSet
232 emptyDVarSet = emptyUniqDSet
233
234 unitDVarSet :: Var -> DVarSet
235 unitDVarSet = unitUniqDSet
236
237 mkDVarSet :: [Var] -> DVarSet
238 mkDVarSet = mkUniqDSet
239
240 extendDVarSet :: DVarSet -> Var -> DVarSet
241 extendDVarSet = addOneToUniqDSet
242
243 elemDVarSet :: Var -> DVarSet -> Bool
244 elemDVarSet = elementOfUniqDSet
245
246 dVarSetElems :: DVarSet -> [Var]
247 dVarSetElems = uniqDSetToList
248
249 subDVarSet :: DVarSet -> DVarSet -> Bool
250 subDVarSet s1 s2 = isEmptyDVarSet (s1 `minusDVarSet` s2)
251
252 unionDVarSet :: DVarSet -> DVarSet -> DVarSet
253 unionDVarSet = unionUniqDSets
254
255 unionDVarSets :: [DVarSet] -> DVarSet
256 unionDVarSets = unionManyUniqDSets
257
258 -- | Map the function over the list, and union the results
259 mapUnionDVarSet :: (a -> DVarSet) -> [a] -> DVarSet
260 mapUnionDVarSet get_set xs = foldr (unionDVarSet . get_set) emptyDVarSet xs
261
262 intersectDVarSet :: DVarSet -> DVarSet -> DVarSet
263 intersectDVarSet = intersectUniqDSets
264
265 dVarSetIntersectVarSet :: DVarSet -> VarSet -> DVarSet
266 dVarSetIntersectVarSet = uniqDSetIntersectUniqSet
267
268 -- | True if empty intersection
269 disjointDVarSet :: DVarSet -> DVarSet -> Bool
270 disjointDVarSet s1 s2 = disjointUDFM s1 s2
271
272 -- | True if non-empty intersection
273 intersectsDVarSet :: DVarSet -> DVarSet -> Bool
274 intersectsDVarSet s1 s2 = not (s1 `disjointDVarSet` s2)
275
276 isEmptyDVarSet :: DVarSet -> Bool
277 isEmptyDVarSet = isEmptyUniqDSet
278
279 delDVarSet :: DVarSet -> Var -> DVarSet
280 delDVarSet = delOneFromUniqDSet
281
282 minusDVarSet :: DVarSet -> DVarSet -> DVarSet
283 minusDVarSet = minusUniqDSet
284
285 dVarSetMinusVarSet :: DVarSet -> VarSet -> DVarSet
286 dVarSetMinusVarSet = uniqDSetMinusUniqSet
287
288 foldDVarSet :: (Var -> a -> a) -> a -> DVarSet -> a
289 foldDVarSet = foldUniqDSet
290
291 anyDVarSet :: (Var -> Bool) -> DVarSet -> Bool
292 anyDVarSet = anyUDFM
293
294 allDVarSet :: (Var -> Bool) -> DVarSet -> Bool
295 allDVarSet = allUDFM
296
297 filterDVarSet :: (Var -> Bool) -> DVarSet -> DVarSet
298 filterDVarSet = filterUniqDSet
299
300 sizeDVarSet :: DVarSet -> Int
301 sizeDVarSet = sizeUniqDSet
302
303 -- | Partition DVarSet according to the predicate given
304 partitionDVarSet :: (Var -> Bool) -> DVarSet -> (DVarSet, DVarSet)
305 partitionDVarSet = partitionUniqDSet
306
307 -- | Delete a list of variables from DVarSet
308 delDVarSetList :: DVarSet -> [Var] -> DVarSet
309 delDVarSetList = delListFromUniqDSet
310
311 seqDVarSet :: DVarSet -> ()
312 seqDVarSet s = sizeDVarSet s `seq` ()
313
314 -- | Add a list of variables to DVarSet
315 extendDVarSetList :: DVarSet -> [Var] -> DVarSet
316 extendDVarSetList = addListToUniqDSet
317
318 -- | Convert a DVarSet to a VarSet by forgeting the order of insertion
319 dVarSetToVarSet :: DVarSet -> VarSet
320 dVarSetToVarSet = unsafeUFMToUniqSet . udfmToUfm
321
322 -- | transCloVarSet for DVarSet
323 transCloDVarSet :: (DVarSet -> DVarSet)
324 -- Map some variables in the set to
325 -- extra variables that should be in it
326 -> DVarSet -> DVarSet
327 -- (transCloDVarSet f s) repeatedly applies f to new candidates, adding any
328 -- new variables to s that it finds thereby, until it reaches a fixed point.
329 --
330 -- The function fn could be (Var -> DVarSet), but we use (DVarSet -> DVarSet)
331 -- for efficiency, so that the test can be batched up.
332 -- It's essential that fn will work fine if given new candidates
333 -- one at at time; ie fn {v1,v2} = fn v1 `union` fn v2
334 transCloDVarSet fn seeds
335 = go seeds seeds
336 where
337 go :: DVarSet -- Accumulating result
338 -> DVarSet -- Work-list; un-processed subset of accumulating result
339 -> DVarSet
340 -- Specification: go acc vs = acc `union` transClo fn vs
341
342 go acc candidates
343 | isEmptyDVarSet new_vs = acc
344 | otherwise = go (acc `unionDVarSet` new_vs) new_vs
345 where
346 new_vs = fn candidates `minusDVarSet` acc