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