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