Fix deprecation warnings from containers
[ghc.git] / compiler / utils / UniqFM.hs
1 {-
2 (c) The University of Glasgow 2006
3 (c) The AQUA Project, Glasgow University, 1994-1998
4
5
6 UniqFM: Specialised finite maps, for things with @Uniques@.
7
8 Basically, the things need to be in class @Uniquable@, and we use the
9 @getUnique@ method to grab their @Uniques@.
10
11 (A similar thing to @UniqSet@, as opposed to @Set@.)
12
13 The interface is based on @FiniteMap@s, but the implementation uses
14 @Data.IntMap@, which is both maintained and faster than the past
15 implementation (see commit log).
16
17 The @UniqFM@ interface maps directly to Data.IntMap, only
18 ``Data.IntMap.union'' is left-biased and ``plusUFM'' right-biased
19 and ``addToUFM\_C'' and ``Data.IntMap.insertWith'' differ in the order
20 of arguments of combining function.
21 -}
22
23 {-# LANGUAGE CPP #-}
24 {-# LANGUAGE DeriveDataTypeable #-}
25 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
26 {-# OPTIONS_GHC -Wall #-}
27
28 module UniqFM (
29 -- * Unique-keyed mappings
30 UniqFM, -- abstract type
31
32 -- ** Manipulating those mappings
33 emptyUFM,
34 unitUFM,
35 unitDirectlyUFM,
36 listToUFM,
37 listToUFM_Directly,
38 listToUFM_C,
39 addToUFM,addToUFM_C,addToUFM_Acc,
40 addListToUFM,addListToUFM_C,
41 addToUFM_Directly,
42 addListToUFM_Directly,
43 adjustUFM, alterUFM,
44 adjustUFM_Directly,
45 delFromUFM,
46 delFromUFM_Directly,
47 delListFromUFM,
48 delListFromUFM_Directly,
49 plusUFM,
50 plusUFM_C,
51 plusUFM_CD,
52 plusUFMList,
53 minusUFM,
54 intersectUFM,
55 intersectUFM_C,
56 disjointUFM,
57 nonDetFoldUFM, foldUFM, nonDetFoldUFM_Directly,
58 anyUFM, allUFM, seqEltsUFM,
59 mapUFM, mapUFM_Directly,
60 elemUFM, elemUFM_Directly,
61 filterUFM, filterUFM_Directly, partitionUFM,
62 sizeUFM,
63 isNullUFM,
64 lookupUFM, lookupUFM_Directly,
65 lookupWithDefaultUFM, lookupWithDefaultUFM_Directly,
66 nonDetEltsUFM, eltsUFM, nonDetKeysUFM,
67 ufmToSet_Directly,
68 nonDetUFMToList, ufmToIntMap,
69 pprUniqFM, pprUFM, pprUFMWithKeys, pluralUFM
70 ) where
71
72 import Unique ( Uniquable(..), Unique, getKey )
73 import Outputable
74
75 import Data.List (foldl')
76
77 import qualified Data.IntMap as M
78 import qualified Data.IntSet as S
79 import Data.Typeable
80 import Data.Data
81 #if __GLASGOW_HASKELL__ > 710
82 import Data.Semigroup ( Semigroup )
83 import qualified Data.Semigroup as Semigroup
84 #endif
85
86
87 newtype UniqFM ele = UFM (M.IntMap ele)
88 deriving (Data, Eq, Functor, Typeable)
89 -- We used to derive Traversable and Foldable, but they were nondeterministic
90 -- and not obvious at the call site. You can use explicit nonDetEltsUFM
91 -- and fold a list if needed.
92 -- See Note [Deterministic UniqFM] in UniqDFM to learn about determinism.
93
94 emptyUFM :: UniqFM elt
95 emptyUFM = UFM M.empty
96
97 isNullUFM :: UniqFM elt -> Bool
98 isNullUFM (UFM m) = M.null m
99
100 unitUFM :: Uniquable key => key -> elt -> UniqFM elt
101 unitUFM k v = UFM (M.singleton (getKey $ getUnique k) v)
102
103 -- when you've got the Unique already
104 unitDirectlyUFM :: Unique -> elt -> UniqFM elt
105 unitDirectlyUFM u v = UFM (M.singleton (getKey u) v)
106
107 listToUFM :: Uniquable key => [(key,elt)] -> UniqFM elt
108 listToUFM = foldl (\m (k, v) -> addToUFM m k v) emptyUFM
109
110 listToUFM_Directly :: [(Unique, elt)] -> UniqFM elt
111 listToUFM_Directly = foldl (\m (u, v) -> addToUFM_Directly m u v) emptyUFM
112
113 listToUFM_C
114 :: Uniquable key
115 => (elt -> elt -> elt)
116 -> [(key, elt)]
117 -> UniqFM elt
118 listToUFM_C f = foldl (\m (k, v) -> addToUFM_C f m k v) emptyUFM
119
120 addToUFM :: Uniquable key => UniqFM elt -> key -> elt -> UniqFM elt
121 addToUFM (UFM m) k v = UFM (M.insert (getKey $ getUnique k) v m)
122
123 addListToUFM :: Uniquable key => UniqFM elt -> [(key,elt)] -> UniqFM elt
124 addListToUFM = foldl (\m (k, v) -> addToUFM m k v)
125
126 addListToUFM_Directly :: UniqFM elt -> [(Unique,elt)] -> UniqFM elt
127 addListToUFM_Directly = foldl (\m (k, v) -> addToUFM_Directly m k v)
128
129 addToUFM_Directly :: UniqFM elt -> Unique -> elt -> UniqFM elt
130 addToUFM_Directly (UFM m) u v = UFM (M.insert (getKey u) v m)
131
132 addToUFM_C
133 :: Uniquable key
134 => (elt -> elt -> elt) -- old -> new -> result
135 -> UniqFM elt -- old
136 -> key -> elt -- new
137 -> UniqFM elt -- result
138 -- Arguments of combining function of M.insertWith and addToUFM_C are flipped.
139 addToUFM_C f (UFM m) k v =
140 UFM (M.insertWith (flip f) (getKey $ getUnique k) v m)
141
142 addToUFM_Acc
143 :: Uniquable key
144 => (elt -> elts -> elts) -- Add to existing
145 -> (elt -> elts) -- New element
146 -> UniqFM elts -- old
147 -> key -> elt -- new
148 -> UniqFM elts -- result
149 addToUFM_Acc exi new (UFM m) k v =
150 UFM (M.insertWith (\_new old -> exi v old) (getKey $ getUnique k) (new v) m)
151
152 alterUFM
153 :: Uniquable key
154 => (Maybe elt -> Maybe elt) -- How to adjust
155 -> UniqFM elt -- old
156 -> key -- new
157 -> UniqFM elt -- result
158 alterUFM f (UFM m) k = UFM (M.alter f (getKey $ getUnique k) m)
159
160 addListToUFM_C
161 :: Uniquable key
162 => (elt -> elt -> elt)
163 -> UniqFM elt -> [(key,elt)]
164 -> UniqFM elt
165 addListToUFM_C f = foldl (\m (k, v) -> addToUFM_C f m k v)
166
167 adjustUFM :: Uniquable key => (elt -> elt) -> UniqFM elt -> key -> UniqFM elt
168 adjustUFM f (UFM m) k = UFM (M.adjust f (getKey $ getUnique k) m)
169
170 adjustUFM_Directly :: (elt -> elt) -> UniqFM elt -> Unique -> UniqFM elt
171 adjustUFM_Directly f (UFM m) u = UFM (M.adjust f (getKey u) m)
172
173 delFromUFM :: Uniquable key => UniqFM elt -> key -> UniqFM elt
174 delFromUFM (UFM m) k = UFM (M.delete (getKey $ getUnique k) m)
175
176 delListFromUFM :: Uniquable key => UniqFM elt -> [key] -> UniqFM elt
177 delListFromUFM = foldl delFromUFM
178
179 delListFromUFM_Directly :: UniqFM elt -> [Unique] -> UniqFM elt
180 delListFromUFM_Directly = foldl delFromUFM_Directly
181
182 delFromUFM_Directly :: UniqFM elt -> Unique -> UniqFM elt
183 delFromUFM_Directly (UFM m) u = UFM (M.delete (getKey u) m)
184
185 -- Bindings in right argument shadow those in the left
186 plusUFM :: UniqFM elt -> UniqFM elt -> UniqFM elt
187 -- M.union is left-biased, plusUFM should be right-biased.
188 plusUFM (UFM x) (UFM y) = UFM (M.union y x)
189 -- Note (M.union y x), with arguments flipped
190 -- M.union is left-biased, plusUFM should be right-biased.
191
192 plusUFM_C :: (elt -> elt -> elt) -> UniqFM elt -> UniqFM elt -> UniqFM elt
193 plusUFM_C f (UFM x) (UFM y) = UFM (M.unionWith f x y)
194
195 -- | `plusUFM_CD f m1 d1 m2 d2` merges the maps using `f` as the
196 -- combinding function and `d1` resp. `d2` as the default value if
197 -- there is no entry in `m1` reps. `m2`. The domain is the union of
198 -- the domains of `m1` and `m2`.
199 --
200 -- Representative example:
201 --
202 -- @
203 -- plusUFM_CD f {A: 1, B: 2} 23 {B: 3, C: 4} 42
204 -- == {A: f 1 42, B: f 2 3, C: f 23 4 }
205 -- @
206 plusUFM_CD
207 :: (elt -> elt -> elt)
208 -> UniqFM elt -- map X
209 -> elt -- default for X
210 -> UniqFM elt -- map Y
211 -> elt -- default for Y
212 -> UniqFM elt
213 plusUFM_CD f (UFM xm) dx (UFM ym) dy
214 = UFM $ M.mergeWithKey
215 (\_ x y -> Just (x `f` y))
216 (M.map (\x -> x `f` dy))
217 (M.map (\y -> dx `f` y))
218 xm ym
219
220 plusUFMList :: [UniqFM elt] -> UniqFM elt
221 plusUFMList = foldl' plusUFM emptyUFM
222
223 minusUFM :: UniqFM elt1 -> UniqFM elt2 -> UniqFM elt1
224 minusUFM (UFM x) (UFM y) = UFM (M.difference x y)
225
226 intersectUFM :: UniqFM elt -> UniqFM elt -> UniqFM elt
227 intersectUFM (UFM x) (UFM y) = UFM (M.intersection x y)
228
229 intersectUFM_C
230 :: (elt1 -> elt2 -> elt3)
231 -> UniqFM elt1
232 -> UniqFM elt2
233 -> UniqFM elt3
234 intersectUFM_C f (UFM x) (UFM y) = UFM (M.intersectionWith f x y)
235
236 disjointUFM :: UniqFM elt1 -> UniqFM elt2 -> Bool
237 disjointUFM (UFM x) (UFM y) = M.null (M.intersection x y)
238
239 foldUFM :: (elt -> a -> a) -> a -> UniqFM elt -> a
240 foldUFM k z (UFM m) = M.foldr k z m
241
242 mapUFM :: (elt1 -> elt2) -> UniqFM elt1 -> UniqFM elt2
243 mapUFM f (UFM m) = UFM (M.map f m)
244
245 mapUFM_Directly :: (Unique -> elt1 -> elt2) -> UniqFM elt1 -> UniqFM elt2
246 mapUFM_Directly f (UFM m) = UFM (M.mapWithKey (f . getUnique) m)
247
248 filterUFM :: (elt -> Bool) -> UniqFM elt -> UniqFM elt
249 filterUFM p (UFM m) = UFM (M.filter p m)
250
251 filterUFM_Directly :: (Unique -> elt -> Bool) -> UniqFM elt -> UniqFM elt
252 filterUFM_Directly p (UFM m) = UFM (M.filterWithKey (p . getUnique) m)
253
254 partitionUFM :: (elt -> Bool) -> UniqFM elt -> (UniqFM elt, UniqFM elt)
255 partitionUFM p (UFM m) =
256 case M.partition p m of
257 (left, right) -> (UFM left, UFM right)
258
259 sizeUFM :: UniqFM elt -> Int
260 sizeUFM (UFM m) = M.size m
261
262 elemUFM :: Uniquable key => key -> UniqFM elt -> Bool
263 elemUFM k (UFM m) = M.member (getKey $ getUnique k) m
264
265 elemUFM_Directly :: Unique -> UniqFM elt -> Bool
266 elemUFM_Directly u (UFM m) = M.member (getKey u) m
267
268 lookupUFM :: Uniquable key => UniqFM elt -> key -> Maybe elt
269 lookupUFM (UFM m) k = M.lookup (getKey $ getUnique k) m
270
271 -- when you've got the Unique already
272 lookupUFM_Directly :: UniqFM elt -> Unique -> Maybe elt
273 lookupUFM_Directly (UFM m) u = M.lookup (getKey u) m
274
275 lookupWithDefaultUFM :: Uniquable key => UniqFM elt -> elt -> key -> elt
276 lookupWithDefaultUFM (UFM m) v k = M.findWithDefault v (getKey $ getUnique k) m
277
278 lookupWithDefaultUFM_Directly :: UniqFM elt -> elt -> Unique -> elt
279 lookupWithDefaultUFM_Directly (UFM m) v u = M.findWithDefault v (getKey u) m
280
281 eltsUFM :: UniqFM elt -> [elt]
282 eltsUFM (UFM m) = M.elems m
283
284 ufmToSet_Directly :: UniqFM elt -> S.IntSet
285 ufmToSet_Directly (UFM m) = M.keysSet m
286
287 anyUFM :: (elt -> Bool) -> UniqFM elt -> Bool
288 anyUFM p (UFM m) = M.foldr ((||) . p) False m
289
290 allUFM :: (elt -> Bool) -> UniqFM elt -> Bool
291 allUFM p (UFM m) = M.foldr ((&&) . p) True m
292
293 seqEltsUFM :: ([elt] -> ()) -> UniqFM elt -> ()
294 seqEltsUFM seqList = seqList . nonDetEltsUFM
295 -- It's OK to use nonDetEltsUFM here because the type guarantees that
296 -- the only interesting thing this function can do is to force the
297 -- elements.
298
299 -- See Note [Deterministic UniqFM] to learn about nondeterminism.
300 -- If you use this please provide a justification why it doesn't introduce
301 -- nondeterminism.
302 nonDetEltsUFM :: UniqFM elt -> [elt]
303 nonDetEltsUFM (UFM m) = M.elems m
304
305 -- See Note [Deterministic UniqFM] to learn about nondeterminism.
306 -- If you use this please provide a justification why it doesn't introduce
307 -- nondeterminism.
308 nonDetKeysUFM :: UniqFM elt -> [Unique]
309 nonDetKeysUFM (UFM m) = map getUnique $ M.keys m
310
311 -- See Note [Deterministic UniqFM] to learn about nondeterminism.
312 -- If you use this please provide a justification why it doesn't introduce
313 -- nondeterminism.
314 nonDetFoldUFM :: (elt -> a -> a) -> a -> UniqFM elt -> a
315 nonDetFoldUFM k z (UFM m) = M.foldr k z m
316
317 -- See Note [Deterministic UniqFM] to learn about nondeterminism.
318 -- If you use this please provide a justification why it doesn't introduce
319 -- nondeterminism.
320 nonDetFoldUFM_Directly:: (Unique -> elt -> a -> a) -> a -> UniqFM elt -> a
321 nonDetFoldUFM_Directly k z (UFM m) = M.foldrWithKey (k . getUnique) z m
322
323 -- See Note [Deterministic UniqFM] to learn about nondeterminism.
324 -- If you use this please provide a justification why it doesn't introduce
325 -- nondeterminism.
326 nonDetUFMToList :: UniqFM elt -> [(Unique, elt)]
327 nonDetUFMToList (UFM m) = map (\(k, v) -> (getUnique k, v)) $ M.toList m
328
329 ufmToIntMap :: UniqFM elt -> M.IntMap elt
330 ufmToIntMap (UFM m) = m
331
332 -- Instances
333
334 #if __GLASGOW_HASKELL__ > 710
335 instance Semigroup (UniqFM a) where
336 (<>) = plusUFM
337 #endif
338
339 instance Monoid (UniqFM a) where
340 mempty = emptyUFM
341 mappend = plusUFM
342
343 -- Output-ery
344
345 instance Outputable a => Outputable (UniqFM a) where
346 ppr ufm = pprUniqFM ppr ufm
347
348 pprUniqFM :: (a -> SDoc) -> UniqFM a -> SDoc
349 pprUniqFM ppr_elt ufm
350 = brackets $ fsep $ punctuate comma $
351 [ ppr uq <+> text ":->" <+> ppr_elt elt
352 | (uq, elt) <- nonDetUFMToList ufm ]
353 -- It's OK to use nonDetUFMToList here because we only use it for
354 -- pretty-printing.
355
356 -- | Pretty-print a non-deterministic set.
357 -- The order of variables is non-deterministic and for pretty-printing that
358 -- shouldn't be a problem.
359 -- Having this function helps contain the non-determinism created with
360 -- nonDetEltsUFM.
361 pprUFM :: UniqFM a -- ^ The things to be pretty printed
362 -> ([a] -> SDoc) -- ^ The pretty printing function to use on the elements
363 -> SDoc -- ^ 'SDoc' where the things have been pretty
364 -- printed
365 pprUFM ufm pp = pp (nonDetEltsUFM ufm)
366
367 -- | Pretty-print a non-deterministic set.
368 -- The order of variables is non-deterministic and for pretty-printing that
369 -- shouldn't be a problem.
370 -- Having this function helps contain the non-determinism created with
371 -- nonDetUFMToList.
372 pprUFMWithKeys
373 :: UniqFM a -- ^ The things to be pretty printed
374 -> ([(Unique, a)] -> SDoc) -- ^ The pretty printing function to use on the elements
375 -> SDoc -- ^ 'SDoc' where the things have been pretty
376 -- printed
377 pprUFMWithKeys ufm pp = pp (nonDetUFMToList ufm)
378
379 -- | Determines the pluralisation suffix appropriate for the length of a set
380 -- in the same way that plural from Outputable does for lists.
381 pluralUFM :: UniqFM a -> SDoc
382 pluralUFM ufm
383 | sizeUFM ufm == 1 = empty
384 | otherwise = char 's'