Document SCC determinism
[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 minusUFM,
53 intersectUFM,
54 intersectUFM_C,
55 disjointUFM,
56 foldUFM, foldUFM_Directly, anyUFM, allUFM,
57 mapUFM, mapUFM_Directly,
58 elemUFM, elemUFM_Directly,
59 filterUFM, filterUFM_Directly, partitionUFM,
60 sizeUFM,
61 isNullUFM,
62 lookupUFM, lookupUFM_Directly,
63 lookupWithDefaultUFM, lookupWithDefaultUFM_Directly,
64 nonDetEltsUFM, eltsUFM, nonDetKeysUFM, keysUFM, splitUFM,
65 ufmToSet_Directly,
66 ufmToList, ufmToIntMap,
67 joinUFM, pprUniqFM, pprUFM, pluralUFM
68 ) where
69
70 import Unique ( Uniquable(..), Unique, getKey )
71 import Outputable
72
73 import Compiler.Hoopl hiding (Unique)
74
75 import qualified Data.IntMap as M
76 import qualified Data.IntSet as S
77 import Data.Typeable
78 import Data.Data
79 #if __GLASGOW_HASKELL__ > 710
80 import Data.Semigroup ( Semigroup )
81 import qualified Data.Semigroup as Semigroup
82 #endif
83
84 {-
85 ************************************************************************
86 * *
87 \subsection{The signature of the module}
88 * *
89 ************************************************************************
90 -}
91
92 emptyUFM :: UniqFM elt
93 isNullUFM :: UniqFM elt -> Bool
94 unitUFM :: Uniquable key => key -> elt -> UniqFM elt
95 unitDirectlyUFM -- got the Unique already
96 :: Unique -> elt -> UniqFM elt
97 listToUFM :: Uniquable key => [(key,elt)] -> UniqFM elt
98 listToUFM_Directly
99 :: [(Unique, elt)] -> UniqFM elt
100 listToUFM_C :: Uniquable key => (elt -> elt -> elt)
101 -> [(key, elt)]
102 -> UniqFM elt
103
104 addToUFM :: Uniquable key => UniqFM elt -> key -> elt -> UniqFM elt
105 addListToUFM :: Uniquable key => UniqFM elt -> [(key,elt)] -> UniqFM elt
106 addListToUFM_Directly :: UniqFM elt -> [(Unique,elt)] -> UniqFM elt
107 addToUFM_Directly
108 :: UniqFM elt -> Unique -> elt -> UniqFM elt
109
110 addToUFM_C :: Uniquable key => (elt -> elt -> elt) -- old -> new -> result
111 -> UniqFM elt -- old
112 -> key -> elt -- new
113 -> UniqFM elt -- result
114
115 addToUFM_Acc :: Uniquable key =>
116 (elt -> elts -> elts) -- Add to existing
117 -> (elt -> elts) -- New element
118 -> UniqFM elts -- old
119 -> key -> elt -- new
120 -> UniqFM elts -- result
121
122 alterUFM :: Uniquable key =>
123 (Maybe elt -> Maybe elt) -- How to adjust
124 -> UniqFM elt -- old
125 -> key -- new
126 -> UniqFM elt -- result
127
128 addListToUFM_C :: Uniquable key => (elt -> elt -> elt)
129 -> UniqFM elt -> [(key,elt)]
130 -> UniqFM elt
131
132 adjustUFM :: Uniquable key => (elt -> elt) -> UniqFM elt -> key -> UniqFM elt
133 adjustUFM_Directly :: (elt -> elt) -> UniqFM elt -> Unique -> UniqFM elt
134
135 delFromUFM :: Uniquable key => UniqFM elt -> key -> UniqFM elt
136 delListFromUFM :: Uniquable key => UniqFM elt -> [key] -> UniqFM elt
137 delListFromUFM_Directly :: UniqFM elt -> [Unique] -> UniqFM elt
138 delFromUFM_Directly :: UniqFM elt -> Unique -> UniqFM elt
139
140 -- Bindings in right argument shadow those in the left
141 plusUFM :: UniqFM elt -> UniqFM elt -> UniqFM elt
142
143 plusUFM_C :: (elt -> elt -> elt)
144 -> UniqFM elt -> UniqFM elt -> UniqFM elt
145
146 -- | `plusUFM_CD f m1 d1 m2 d2` merges the maps using `f` as the
147 -- combinding function and `d1` resp. `d2` as the default value if
148 -- there is no entry in `m1` reps. `m2`. The domain is the union of
149 -- the domains of `m1` and `m2`.
150 --
151 -- Representative example:
152 --
153 -- @
154 -- plusUFM_CD f {A: 1, B: 2} 23 {B: 3, C: 4} 42
155 -- == {A: f 1 42, B: f 2 3, C: f 23 4 }
156 -- @
157 plusUFM_CD :: (elt -> elt -> elt)
158 -> UniqFM elt -> elt -> UniqFM elt -> elt -> UniqFM elt
159
160 minusUFM :: UniqFM elt1 -> UniqFM elt2 -> UniqFM elt1
161
162 intersectUFM :: UniqFM elt -> UniqFM elt -> UniqFM elt
163 intersectUFM_C :: (elt1 -> elt2 -> elt3)
164 -> UniqFM elt1 -> UniqFM elt2 -> UniqFM elt3
165 disjointUFM :: UniqFM elt1 -> UniqFM elt2 -> Bool
166
167 foldUFM :: (elt -> a -> a) -> a -> UniqFM elt -> a
168 foldUFM_Directly:: (Unique -> elt -> a -> a) -> a -> UniqFM elt -> a
169 mapUFM :: (elt1 -> elt2) -> UniqFM elt1 -> UniqFM elt2
170 mapUFM_Directly :: (Unique -> elt1 -> elt2) -> UniqFM elt1 -> UniqFM elt2
171 filterUFM :: (elt -> Bool) -> UniqFM elt -> UniqFM elt
172 filterUFM_Directly :: (Unique -> elt -> Bool) -> UniqFM elt -> UniqFM elt
173 partitionUFM :: (elt -> Bool) -> UniqFM elt -> (UniqFM elt, UniqFM elt)
174
175 sizeUFM :: UniqFM elt -> Int
176 --hashUFM :: UniqFM elt -> Int
177 elemUFM :: Uniquable key => key -> UniqFM elt -> Bool
178 elemUFM_Directly:: Unique -> UniqFM elt -> Bool
179
180 splitUFM :: Uniquable key => UniqFM elt -> key -> (UniqFM elt, Maybe elt, UniqFM elt)
181 -- Splits a UFM into things less than, equal to, and greater than the key
182 lookupUFM :: Uniquable key => UniqFM elt -> key -> Maybe elt
183 lookupUFM_Directly -- when you've got the Unique already
184 :: UniqFM elt -> Unique -> Maybe elt
185 lookupWithDefaultUFM
186 :: Uniquable key => UniqFM elt -> elt -> key -> elt
187 lookupWithDefaultUFM_Directly
188 :: UniqFM elt -> elt -> Unique -> elt
189 keysUFM :: UniqFM elt -> [Unique] -- Get the keys
190 eltsUFM :: UniqFM elt -> [elt]
191 ufmToSet_Directly :: UniqFM elt -> S.IntSet
192 ufmToList :: UniqFM elt -> [(Unique, elt)]
193
194 {-
195 ************************************************************************
196 * *
197 \subsection{Monoid interface}
198 * *
199 ************************************************************************
200 -}
201
202 #if __GLASGOW_HASKELL__ > 710
203 instance Semigroup (UniqFM a) where
204 (<>) = plusUFM
205 #endif
206
207 instance Monoid (UniqFM a) where
208 mempty = emptyUFM
209 mappend = plusUFM
210
211 {-
212 ************************************************************************
213 * *
214 \subsection{Implementation using ``Data.IntMap''}
215 * *
216 ************************************************************************
217 -}
218
219
220 newtype UniqFM ele = UFM (M.IntMap ele)
221 deriving (Data, Eq, Functor, Typeable)
222 -- We used to derive Traversable and Foldable, but they were nondeterministic
223 -- and not obvious at the call site. You can use explicit nonDetEltsUFM
224 -- and fold a list if needed.
225 -- See Note [Deterministic UniqFM] in UniqDFM to learn about determinism.
226
227 emptyUFM = UFM M.empty
228 isNullUFM (UFM m) = M.null m
229 unitUFM k v = UFM (M.singleton (getKey $ getUnique k) v)
230 unitDirectlyUFM u v = UFM (M.singleton (getKey u) v)
231 listToUFM = foldl (\m (k, v) -> addToUFM m k v) emptyUFM
232 listToUFM_Directly = foldl (\m (u, v) -> addToUFM_Directly m u v) emptyUFM
233 listToUFM_C f = foldl (\m (k, v) -> addToUFM_C f m k v) emptyUFM
234
235 alterUFM f (UFM m) k = UFM (M.alter f (getKey $ getUnique k) m)
236 addToUFM (UFM m) k v = UFM (M.insert (getKey $ getUnique k) v m)
237 addListToUFM = foldl (\m (k, v) -> addToUFM m k v)
238 addListToUFM_Directly = foldl (\m (k, v) -> addToUFM_Directly m k v)
239 addToUFM_Directly (UFM m) u v = UFM (M.insert (getKey u) v m)
240
241 -- Arguments of combining function of M.insertWith and addToUFM_C are flipped.
242 addToUFM_C f (UFM m) k v =
243 UFM (M.insertWith (flip f) (getKey $ getUnique k) v m)
244 addToUFM_Acc exi new (UFM m) k v =
245 UFM (M.insertWith (\_new old -> exi v old) (getKey $ getUnique k) (new v) m)
246 addListToUFM_C f = foldl (\m (k, v) -> addToUFM_C f m k v)
247
248 adjustUFM f (UFM m) k = UFM (M.adjust f (getKey $ getUnique k) m)
249 adjustUFM_Directly f (UFM m) u = UFM (M.adjust f (getKey u) m)
250
251 delFromUFM (UFM m) k = UFM (M.delete (getKey $ getUnique k) m)
252 delListFromUFM = foldl delFromUFM
253 delFromUFM_Directly (UFM m) u = UFM (M.delete (getKey u) m)
254 delListFromUFM_Directly = foldl delFromUFM_Directly
255
256 -- M.union is left-biased, plusUFM should be right-biased.
257 plusUFM (UFM x) (UFM y) = UFM (M.union y x)
258 -- Note (M.union y x), with arguments flipped
259 -- M.union is left-biased, plusUFM should be right-biased.
260
261 plusUFM_C f (UFM x) (UFM y) = UFM (M.unionWith f x y)
262
263 plusUFM_CD f (UFM xm) dx (UFM ym) dy
264 = UFM $ M.mergeWithKey
265 (\_ x y -> Just (x `f` y))
266 (M.map (\x -> x `f` dy))
267 (M.map (\y -> dx `f` y))
268 xm ym
269 minusUFM (UFM x) (UFM y) = UFM (M.difference x y)
270 intersectUFM (UFM x) (UFM y) = UFM (M.intersection x y)
271 intersectUFM_C f (UFM x) (UFM y) = UFM (M.intersectionWith f x y)
272 disjointUFM (UFM x) (UFM y) = M.null (M.intersection x y)
273
274 foldUFM k z (UFM m) = M.fold k z m
275
276
277 foldUFM_Directly k z (UFM m) = M.foldWithKey (k . getUnique) z m
278 mapUFM f (UFM m) = UFM (M.map f m)
279 mapUFM_Directly f (UFM m) = UFM (M.mapWithKey (f . getUnique) m)
280 filterUFM p (UFM m) = UFM (M.filter p m)
281 filterUFM_Directly p (UFM m) = UFM (M.filterWithKey (p . getUnique) m)
282 partitionUFM p (UFM m) = case M.partition p m of
283 (left, right) -> (UFM left, UFM right)
284
285 sizeUFM (UFM m) = M.size m
286 elemUFM k (UFM m) = M.member (getKey $ getUnique k) m
287 elemUFM_Directly u (UFM m) = M.member (getKey u) m
288
289 splitUFM (UFM m) k = case M.splitLookup (getKey $ getUnique k) m of
290 (less, equal, greater) -> (UFM less, equal, UFM greater)
291 lookupUFM (UFM m) k = M.lookup (getKey $ getUnique k) m
292 lookupUFM_Directly (UFM m) u = M.lookup (getKey u) m
293 lookupWithDefaultUFM (UFM m) v k = M.findWithDefault v (getKey $ getUnique k) m
294 lookupWithDefaultUFM_Directly (UFM m) v u = M.findWithDefault v (getKey u) m
295 keysUFM (UFM m) = map getUnique $ M.keys m
296 eltsUFM (UFM m) = M.elems m
297 ufmToSet_Directly (UFM m) = M.keysSet m
298 ufmToList (UFM m) = map (\(k, v) -> (getUnique k, v)) $ M.toList m
299
300 anyUFM :: (elt -> Bool) -> UniqFM elt -> Bool
301 anyUFM p (UFM m) = M.fold ((||) . p) False m
302
303 allUFM :: (elt -> Bool) -> UniqFM elt -> Bool
304 allUFM p (UFM m) = M.fold ((&&) . p) True m
305
306 -- See Note [Deterministic UniqFM] to learn about nondeterminism.
307 -- If you use this please provide a justification why it doesn't introduce
308 -- nondeterminism.
309 nonDetEltsUFM :: UniqFM elt -> [elt]
310 nonDetEltsUFM (UFM m) = M.elems m
311
312 -- See Note [Deterministic UniqFM] to learn about nondeterminism.
313 -- If you use this please provide a justification why it doesn't introduce
314 -- nondeterminism.
315 nonDetKeysUFM :: UniqFM elt -> [Unique]
316 nonDetKeysUFM (UFM m) = map getUnique $ M.keys m
317
318 ufmToIntMap :: UniqFM elt -> M.IntMap elt
319 ufmToIntMap (UFM m) = m
320
321 -- Hoopl
322 joinUFM :: JoinFun v -> JoinFun (UniqFM v)
323 joinUFM eltJoin l (OldFact old) (NewFact new) = foldUFM_Directly add (NoChange, old) new
324 where add k new_v (ch, joinmap) =
325 case lookupUFM_Directly joinmap k of
326 Nothing -> (SomeChange, addToUFM_Directly joinmap k new_v)
327 Just old_v -> case eltJoin l (OldFact old_v) (NewFact new_v) of
328 (SomeChange, v') -> (SomeChange, addToUFM_Directly joinmap k v')
329 (NoChange, _) -> (ch, joinmap)
330
331 {-
332 ************************************************************************
333 * *
334 \subsection{Output-ery}
335 * *
336 ************************************************************************
337 -}
338
339 instance Outputable a => Outputable (UniqFM a) where
340 ppr ufm = pprUniqFM ppr ufm
341
342 pprUniqFM :: (a -> SDoc) -> UniqFM a -> SDoc
343 pprUniqFM ppr_elt ufm
344 = brackets $ fsep $ punctuate comma $
345 [ ppr uq <+> text ":->" <+> ppr_elt elt
346 | (uq, elt) <- ufmToList ufm ]
347
348 -- | Pretty-print a non-deterministic set.
349 -- The order of variables is non-deterministic and for pretty-printing that
350 -- shouldn't be a problem.
351 -- Having this function helps contain the non-determinism created with
352 -- eltsUFM.
353 pprUFM :: ([a] -> SDoc) -- ^ The pretty printing function to use on the elements
354 -> UniqFM a -- ^ The things to be pretty printed
355 -> SDoc -- ^ 'SDoc' where the things have been pretty
356 -- printed
357 pprUFM pp ufm = pp (nonDetEltsUFM ufm)
358
359 -- | Determines the pluralisation suffix appropriate for the length of a set
360 -- in the same way that plural from Outputable does for lists.
361 pluralUFM :: UniqFM a -> SDoc
362 pluralUFM ufm
363 | sizeUFM ufm == 1 = empty
364 | otherwise = char 's'