Merge non-moving garbage collector
[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, mapDVarSet,
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 -- The new element always goes to the right of existing ones.
241 extendDVarSet :: DVarSet -> Var -> DVarSet
242 extendDVarSet = addOneToUniqDSet
243
244 elemDVarSet :: Var -> DVarSet -> Bool
245 elemDVarSet = elementOfUniqDSet
246
247 dVarSetElems :: DVarSet -> [Var]
248 dVarSetElems = uniqDSetToList
249
250 subDVarSet :: DVarSet -> DVarSet -> Bool
251 subDVarSet s1 s2 = isEmptyDVarSet (s1 `minusDVarSet` s2)
252
253 unionDVarSet :: DVarSet -> DVarSet -> DVarSet
254 unionDVarSet = unionUniqDSets
255
256 unionDVarSets :: [DVarSet] -> DVarSet
257 unionDVarSets = unionManyUniqDSets
258
259 -- | Map the function over the list, and union the results
260 mapUnionDVarSet :: (a -> DVarSet) -> [a] -> DVarSet
261 mapUnionDVarSet get_set xs = foldr (unionDVarSet . get_set) emptyDVarSet xs
262
263 intersectDVarSet :: DVarSet -> DVarSet -> DVarSet
264 intersectDVarSet = intersectUniqDSets
265
266 dVarSetIntersectVarSet :: DVarSet -> VarSet -> DVarSet
267 dVarSetIntersectVarSet = uniqDSetIntersectUniqSet
268
269 -- | True if empty intersection
270 disjointDVarSet :: DVarSet -> DVarSet -> Bool
271 disjointDVarSet s1 s2 = disjointUDFM (getUniqDSet s1) (getUniqDSet s2)
272
273 -- | True if non-empty intersection
274 intersectsDVarSet :: DVarSet -> DVarSet -> Bool
275 intersectsDVarSet s1 s2 = not (s1 `disjointDVarSet` s2)
276
277 isEmptyDVarSet :: DVarSet -> Bool
278 isEmptyDVarSet = isEmptyUniqDSet
279
280 delDVarSet :: DVarSet -> Var -> DVarSet
281 delDVarSet = delOneFromUniqDSet
282
283 minusDVarSet :: DVarSet -> DVarSet -> DVarSet
284 minusDVarSet = minusUniqDSet
285
286 dVarSetMinusVarSet :: DVarSet -> VarSet -> DVarSet
287 dVarSetMinusVarSet = uniqDSetMinusUniqSet
288
289 foldDVarSet :: (Var -> a -> a) -> a -> DVarSet -> a
290 foldDVarSet = foldUniqDSet
291
292 anyDVarSet :: (Var -> Bool) -> DVarSet -> Bool
293 anyDVarSet p = anyUDFM p . getUniqDSet
294
295 allDVarSet :: (Var -> Bool) -> DVarSet -> Bool
296 allDVarSet p = allUDFM p . getUniqDSet
297
298 mapDVarSet :: Uniquable b => (a -> b) -> UniqDSet a -> UniqDSet b
299 mapDVarSet = mapUniqDSet
300
301 filterDVarSet :: (Var -> Bool) -> DVarSet -> DVarSet
302 filterDVarSet = filterUniqDSet
303
304 sizeDVarSet :: DVarSet -> Int
305 sizeDVarSet = sizeUniqDSet
306
307 -- | Partition DVarSet according to the predicate given
308 partitionDVarSet :: (Var -> Bool) -> DVarSet -> (DVarSet, DVarSet)
309 partitionDVarSet = partitionUniqDSet
310
311 -- | Delete a list of variables from DVarSet
312 delDVarSetList :: DVarSet -> [Var] -> DVarSet
313 delDVarSetList = delListFromUniqDSet
314
315 seqDVarSet :: DVarSet -> ()
316 seqDVarSet s = sizeDVarSet s `seq` ()
317
318 -- | Add a list of variables to DVarSet
319 extendDVarSetList :: DVarSet -> [Var] -> DVarSet
320 extendDVarSetList = addListToUniqDSet
321
322 -- | Convert a DVarSet to a VarSet by forgeting the order of insertion
323 dVarSetToVarSet :: DVarSet -> VarSet
324 dVarSetToVarSet = unsafeUFMToUniqSet . udfmToUfm . getUniqDSet
325
326 -- | transCloVarSet for DVarSet
327 transCloDVarSet :: (DVarSet -> DVarSet)
328 -- Map some variables in the set to
329 -- extra variables that should be in it
330 -> DVarSet -> DVarSet
331 -- (transCloDVarSet f s) repeatedly applies f to new candidates, adding any
332 -- new variables to s that it finds thereby, until it reaches a fixed point.
333 --
334 -- The function fn could be (Var -> DVarSet), but we use (DVarSet -> DVarSet)
335 -- for efficiency, so that the test can be batched up.
336 -- It's essential that fn will work fine if given new candidates
337 -- one at at time; ie fn {v1,v2} = fn v1 `union` fn v2
338 transCloDVarSet fn seeds
339 = go seeds seeds
340 where
341 go :: DVarSet -- Accumulating result
342 -> DVarSet -- Work-list; un-processed subset of accumulating result
343 -> DVarSet
344 -- Specification: go acc vs = acc `union` transClo fn vs
345
346 go acc candidates
347 | isEmptyDVarSet new_vs = acc
348 | otherwise = go (acc `unionDVarSet` new_vs) new_vs
349 where
350 new_vs = fn candidates `minusDVarSet` acc