Kill varSetElemsWellScoped in quantifyTyVars
[ghc.git] / compiler / utils / UniqDFM.hs
1 {-
2 (c) Bartosz Nitka, Facebook, 2015
3
4 UniqDFM: Specialised deterministic finite maps, for things with @Uniques@.
5
6 Basically, the things need to be in class @Uniquable@, and we use the
7 @getUnique@ method to grab their @Uniques@.
8
9 This is very similar to @UniqFM@, the major difference being that the order of
10 folding is not dependent on @Unique@ ordering, giving determinism.
11 Currently the ordering is determined by insertion order.
12
13 See Note [Unique Determinism] in Unique for explanation why @Unique@ ordering
14 is not deterministic.
15 -}
16
17 {-# LANGUAGE DeriveDataTypeable #-}
18 {-# LANGUAGE DeriveFunctor #-}
19 {-# LANGUAGE FlexibleContexts #-}
20 {-# OPTIONS_GHC -Wall #-}
21
22 module UniqDFM (
23 -- * Unique-keyed deterministic mappings
24 UniqDFM, -- abstract type
25
26 -- ** Manipulating those mappings
27 emptyUDFM,
28 unitUDFM,
29 addToUDFM,
30 delFromUDFM,
31 delListFromUDFM,
32 adjustUDFM,
33 alterUDFM,
34 mapUDFM,
35 plusUDFM,
36 lookupUDFM,
37 elemUDFM,
38 foldUDFM,
39 eltsUDFM,
40 filterUDFM,
41 isNullUDFM,
42 sizeUDFM,
43 intersectUDFM,
44 intersectsUDFM,
45 disjointUDFM,
46 minusUDFM,
47 udfmMinusUFM,
48 partitionUDFM,
49
50 udfmToList,
51 udfmToUfm,
52 alwaysUnsafeUfmToUdfm,
53 ) where
54
55 import Unique ( Uniquable(..), Unique, getKey )
56 import Outputable
57
58 import qualified Data.IntMap as M
59 import Data.Typeable
60 import Data.Data
61 import Data.List (sortBy)
62 import Data.Function (on)
63 import UniqFM (UniqFM, listToUFM_Directly, ufmToList, ufmToIntMap)
64
65 -- Note [Deterministic UniqFM]
66 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~
67 -- A @UniqDFM@ is just like @UniqFM@ with the following additional
68 -- property: the function `udfmToList` returns the elements in some
69 -- deterministic order not depending on the Unique key for those elements.
70 --
71 -- If the client of the map performs operations on the map in deterministic
72 -- order then `udfmToList` returns them in deterministic order.
73 --
74 -- There is an implementation cost: each element is given a serial number
75 -- as it is added, and `udfmToList` sorts it's result by this serial
76 -- number. So you should only use `UniqDFM` if you need the deterministic
77 -- property.
78 --
79 -- `foldUDFM` also preserves determinism.
80 --
81 -- Normal @UniqFM@ when you turn it into a list will use
82 -- Data.IntMap.toList function that returns the elements in the order of
83 -- the keys. The keys in @UniqFM@ are always @Uniques@, so you end up with
84 -- with a list ordered by @Uniques@.
85 -- The order of @Uniques@ is known to be not stable across rebuilds.
86 -- See Note [Unique Determinism] in Unique.
87 --
88 --
89 -- There's more than one way to implement this. The implementation here tags
90 -- every value with the insertion time that can later be used to sort the
91 -- values when asked to convert to a list.
92 --
93 -- An alternative would be to have
94 --
95 -- data UniqDFM ele = UDFM (M.IntMap ele) [ele]
96 --
97 -- where the list determines the order. This makes deletion tricky as we'd
98 -- only accumulate elements in that list, but makes merging easier as you
99 -- can just merge both structures independently.
100 -- Deletion can probably be done in amortized fashion when the size of the
101 -- list is twice the size of the set.
102
103 -- | A type of values tagged with insertion time
104 data TaggedVal val =
105 TaggedVal
106 val
107 {-# UNPACK #-} !Int -- ^ insertion time
108 deriving (Data, Typeable)
109
110 taggedFst :: TaggedVal val -> val
111 taggedFst (TaggedVal v _) = v
112
113 taggedSnd :: TaggedVal val -> Int
114 taggedSnd (TaggedVal _ i) = i
115
116 instance Eq val => Eq (TaggedVal val) where
117 (TaggedVal v1 _) == (TaggedVal v2 _) = v1 == v2
118
119 instance Functor TaggedVal where
120 fmap f (TaggedVal val i) = TaggedVal (f val) i
121
122 -- | Type of unique deterministic finite maps
123 data UniqDFM ele =
124 UDFM
125 !(M.IntMap (TaggedVal ele)) -- A map where keys are Unique's values and
126 -- values are tagged with insertion time.
127 -- The invariant is that all the tags will
128 -- be distinct within a single map
129 {-# UNPACK #-} !Int -- Upper bound on the values' insertion
130 -- time. See Note [Overflow on plusUDFM]
131 deriving (Data, Typeable, Functor)
132
133 emptyUDFM :: UniqDFM elt
134 emptyUDFM = UDFM M.empty 0
135
136 unitUDFM :: Uniquable key => key -> elt -> UniqDFM elt
137 unitUDFM k v = UDFM (M.singleton (getKey $ getUnique k) (TaggedVal v 0)) 1
138
139 addToUDFM :: Uniquable key => UniqDFM elt -> key -> elt -> UniqDFM elt
140 addToUDFM (UDFM m i) k v =
141 UDFM (M.insert (getKey $ getUnique k) (TaggedVal v i) m) (i + 1)
142
143 addToUDFM_Directly :: UniqDFM elt -> Unique -> elt -> UniqDFM elt
144 addToUDFM_Directly (UDFM m i) u v =
145 UDFM (M.insert (getKey u) (TaggedVal v i) m) (i + 1)
146
147 addListToUDFM_Directly :: UniqDFM elt -> [(Unique,elt)] -> UniqDFM elt
148 addListToUDFM_Directly = foldl (\m (k, v) -> addToUDFM_Directly m k v)
149
150 delFromUDFM :: Uniquable key => UniqDFM elt -> key -> UniqDFM elt
151 delFromUDFM (UDFM m i) k = UDFM (M.delete (getKey $ getUnique k) m) i
152
153 -- Note [Overflow on plusUDFM]
154 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~
155 -- There are multiple ways of implementing plusUDFM.
156 -- The main problem that needs to be solved is overlap on times of
157 -- insertion between different keys in two maps.
158 -- Consider:
159 --
160 -- A = fromList [(a, (x, 1))]
161 -- B = fromList [(b, (y, 1))]
162 --
163 -- If you merge them naively you end up with:
164 --
165 -- C = fromList [(a, (x, 1)), (b, (y, 1))]
166 --
167 -- Which loses information about ordering and brings us back into
168 -- non-deterministic world.
169 --
170 -- The solution I considered before would increment the tags on one of the
171 -- sets by the upper bound of the other set. The problem with this approach
172 -- is that you'll run out of tags for some merge patterns.
173 -- Say you start with A with upper bound 1, you merge A with A to get A' and
174 -- the upper bound becomes 2. You merge A' with A' and the upper bound
175 -- doubles again. After 64 merges you overflow.
176 -- This solution would have the same time complexity as plusUFM, namely O(n+m).
177 --
178 -- The solution I ended up with has time complexity of
179 -- O(m log m + m * min (n+m, W)) where m is the smaller set.
180 -- It simply inserts the elements of the smaller set into the larger
181 -- set in the order that they were inserted into the smaller set. That's
182 -- O(m log m) for extracting the elements from the smaller set in the
183 -- insertion order and O(m * min(n+m, W)) to insert them into the bigger
184 -- set.
185
186 plusUDFM :: UniqDFM elt -> UniqDFM elt -> UniqDFM elt
187 plusUDFM udfml@(UDFM _ i) udfmr@(UDFM _ j)
188 -- we will use the upper bound on the tag as a proxy for the set size,
189 -- to insert the smaller one into the bigger one
190 | i > j = insertUDFMIntoLeft udfml udfmr
191 | otherwise = insertUDFMIntoLeft udfmr udfml
192
193 insertUDFMIntoLeft :: UniqDFM elt -> UniqDFM elt -> UniqDFM elt
194 insertUDFMIntoLeft udfml udfmr = addListToUDFM_Directly udfml $ udfmToList udfmr
195
196 lookupUDFM :: Uniquable key => UniqDFM elt -> key -> Maybe elt
197 lookupUDFM (UDFM m _i) k = taggedFst `fmap` M.lookup (getKey $ getUnique k) m
198
199 elemUDFM :: Uniquable key => key -> UniqDFM elt -> Bool
200 elemUDFM k (UDFM m _i) = M.member (getKey $ getUnique k) m
201
202 -- | Performs a deterministic fold over the UniqDFM.
203 -- It's O(n log n) while the corresponding function on `UniqFM` is O(n).
204 foldUDFM :: (elt -> a -> a) -> a -> UniqDFM elt -> a
205 foldUDFM k z m = foldr k z (eltsUDFM m)
206
207 eltsUDFM :: UniqDFM elt -> [elt]
208 eltsUDFM (UDFM m _i) =
209 map taggedFst $ sortBy (compare `on` taggedSnd) $ M.elems m
210
211 filterUDFM :: (elt -> Bool) -> UniqDFM elt -> UniqDFM elt
212 filterUDFM p (UDFM m i) = UDFM (M.filter (\(TaggedVal v _) -> p v) m) i
213
214 -- | Converts `UniqDFM` to a list, with elements in deterministic order.
215 -- It's O(n log n) while the corresponding function on `UniqFM` is O(n).
216 udfmToList :: UniqDFM elt -> [(Unique, elt)]
217 udfmToList (UDFM m _i) =
218 [ (getUnique k, taggedFst v)
219 | (k, v) <- sortBy (compare `on` (taggedSnd . snd)) $ M.toList m ]
220
221 isNullUDFM :: UniqDFM elt -> Bool
222 isNullUDFM (UDFM m _) = M.null m
223
224 sizeUDFM :: UniqDFM elt -> Int
225 sizeUDFM (UDFM m _i) = M.size m
226
227 intersectUDFM :: UniqDFM elt -> UniqDFM elt -> UniqDFM elt
228 intersectUDFM (UDFM x i) (UDFM y _j) = UDFM (M.intersection x y) i
229 -- M.intersection is left biased, that means the result will only have
230 -- a subset of elements from the left set, so `i` is a good upper bound.
231
232 intersectsUDFM :: UniqDFM elt -> UniqDFM elt -> Bool
233 intersectsUDFM x y = isNullUDFM (x `intersectUDFM` y)
234
235 disjointUDFM :: UniqDFM elt -> UniqDFM elt -> Bool
236 disjointUDFM (UDFM x _i) (UDFM y _j) = M.null (M.intersection x y)
237
238 minusUDFM :: UniqDFM elt1 -> UniqDFM elt2 -> UniqDFM elt1
239 minusUDFM (UDFM x i) (UDFM y _j) = UDFM (M.difference x y) i
240 -- M.difference returns a subset of a left set, so `i` is a good upper
241 -- bound.
242
243 udfmMinusUFM :: UniqDFM elt1 -> UniqFM elt2 -> UniqDFM elt1
244 udfmMinusUFM (UDFM x i) y = UDFM (M.difference x (ufmToIntMap y)) i
245 -- M.difference returns a subset of a left set, so `i` is a good upper
246 -- bound.
247
248 -- | Partition UniqDFM into two UniqDFMs according to the predicate
249 partitionUDFM :: (elt -> Bool) -> UniqDFM elt -> (UniqDFM elt, UniqDFM elt)
250 partitionUDFM p (UDFM m i) =
251 case M.partition (p . taggedFst) m of
252 (left, right) -> (UDFM left i, UDFM right i)
253
254 -- | Delete a list of elements from a UniqDFM
255 delListFromUDFM :: Uniquable key => UniqDFM elt -> [key] -> UniqDFM elt
256 delListFromUDFM = foldl delFromUDFM
257
258 -- | This allows for lossy conversion from UniqDFM to UniqFM
259 udfmToUfm :: UniqDFM elt -> UniqFM elt
260 udfmToUfm (UDFM m _i) =
261 listToUFM_Directly [(getUnique k, taggedFst tv) | (k, tv) <- M.toList m]
262
263 listToUDFM_Directly :: [(Unique, elt)] -> UniqDFM elt
264 listToUDFM_Directly = foldl (\m (u, v) -> addToUDFM_Directly m u v) emptyUDFM
265
266 -- | Apply a function to a particular element
267 adjustUDFM :: Uniquable key => (elt -> elt) -> UniqDFM elt -> key -> UniqDFM elt
268 adjustUDFM f (UDFM m i) k = UDFM (M.adjust (fmap f) (getKey $ getUnique k) m) i
269
270 -- | The expression (alterUDFM f k map) alters value x at k, or absence
271 -- thereof. alterUDFM can be used to insert, delete, or update a value in
272 -- UniqDFM. Use addToUDFM, delFromUDFM or adjustUDFM when possible, they are
273 -- more efficient.
274 alterUDFM
275 :: Uniquable key
276 => (Maybe elt -> Maybe elt) -- How to adjust
277 -> UniqDFM elt -- old
278 -> key -- new
279 -> UniqDFM elt -- result
280 alterUDFM f (UDFM m i) k =
281 UDFM (M.alter alterf (getKey $ getUnique k) m) (i + 1)
282 where
283 alterf Nothing = inject $ f Nothing
284 alterf (Just (TaggedVal v _)) = inject $ f (Just v)
285 inject Nothing = Nothing
286 inject (Just v) = Just $ TaggedVal v i
287
288 -- | Map a function over every value in a UniqDFM
289 mapUDFM :: (elt1 -> elt2) -> UniqDFM elt1 -> UniqDFM elt2
290 mapUDFM f (UDFM m i) = UDFM (M.map (fmap f) m) i
291
292 instance Monoid (UniqDFM a) where
293 mempty = emptyUDFM
294 mappend = plusUDFM
295
296 -- This should not be used in commited code, provided for convenience to
297 -- make ad-hoc conversions when developing
298 alwaysUnsafeUfmToUdfm :: UniqFM elt -> UniqDFM elt
299 alwaysUnsafeUfmToUdfm = listToUDFM_Directly . ufmToList
300
301 -- Output-ery
302
303 instance Outputable a => Outputable (UniqDFM a) where
304 ppr ufm = pprUniqDFM ppr ufm
305
306 pprUniqDFM :: (a -> SDoc) -> UniqDFM a -> SDoc
307 pprUniqDFM ppr_elt ufm
308 = brackets $ fsep $ punctuate comma $
309 [ ppr uq <+> text ":->" <+> ppr_elt elt
310 | (uq, elt) <- udfmToList ufm ]