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