never executed always true always false
1 {-
2 (c) The University of Glasgow 2006
3 (c) The AQUA Project, Glasgow University, 1994-1998
4
5 \section[UniqSet]{Specialised sets, for things with @Uniques@}
6
7 Based on @UniqFMs@ (as you would expect).
8
9 Basically, the things need to be in class @Uniquable@.
10 -}
11 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
12 {-# LANGUAGE DeriveDataTypeable #-}
13
14 module GHC.Types.Unique.Set (
15 -- * Unique set type
16 UniqSet, -- type synonym for UniqFM a
17 getUniqSet,
18 pprUniqSet,
19
20 -- ** Manipulating these sets
21 emptyUniqSet,
22 unitUniqSet,
23 mkUniqSet,
24 addOneToUniqSet, addListToUniqSet,
25 delOneFromUniqSet, delOneFromUniqSet_Directly, delListFromUniqSet,
26 delListFromUniqSet_Directly,
27 unionUniqSets, unionManyUniqSets,
28 minusUniqSet, uniqSetMinusUFM, uniqSetMinusUDFM,
29 intersectUniqSets,
30 disjointUniqSets,
31 restrictUniqSetToUFM,
32 uniqSetAny, uniqSetAll,
33 elementOfUniqSet,
34 elemUniqSet_Directly,
35 filterUniqSet,
36 filterUniqSet_Directly,
37 sizeUniqSet,
38 isEmptyUniqSet,
39 lookupUniqSet,
40 lookupUniqSet_Directly,
41 partitionUniqSet,
42 mapUniqSet,
43 unsafeUFMToUniqSet,
44 nonDetEltsUniqSet,
45 nonDetKeysUniqSet,
46 nonDetStrictFoldUniqSet,
47 ) where
48
49 import GHC.Prelude
50
51 import GHC.Types.Unique.DFM
52 import GHC.Types.Unique.FM
53 import GHC.Types.Unique
54 import Data.Coerce
55 import GHC.Utils.Outputable
56 import Data.Data
57 import qualified Data.Semigroup as Semi
58
59 -- Note [UniqSet invariant]
60 -- ~~~~~~~~~~~~~~~~~~~~~~~~~
61 -- UniqSet has the following invariant:
62 -- The keys in the map are the uniques of the values
63 -- It means that to implement mapUniqSet you have to update
64 -- both the keys and the values.
65
66 newtype UniqSet a = UniqSet {getUniqSet' :: UniqFM a a}
67 deriving (Data, Semi.Semigroup, Monoid)
68
69 emptyUniqSet :: UniqSet a
70 emptyUniqSet = UniqSet emptyUFM
71
72 unitUniqSet :: Uniquable a => a -> UniqSet a
73 unitUniqSet x = UniqSet $ unitUFM x x
74
75 mkUniqSet :: Uniquable a => [a] -> UniqSet a
76 mkUniqSet = foldl' addOneToUniqSet emptyUniqSet
77
78 addOneToUniqSet :: Uniquable a => UniqSet a -> a -> UniqSet a
79 addOneToUniqSet (UniqSet set) x = UniqSet (addToUFM set x x)
80
81 addListToUniqSet :: Uniquable a => UniqSet a -> [a] -> UniqSet a
82 addListToUniqSet = foldl' addOneToUniqSet
83
84 delOneFromUniqSet :: Uniquable a => UniqSet a -> a -> UniqSet a
85 delOneFromUniqSet (UniqSet s) a = UniqSet (delFromUFM s a)
86
87 delOneFromUniqSet_Directly :: UniqSet a -> Unique -> UniqSet a
88 delOneFromUniqSet_Directly (UniqSet s) u = UniqSet (delFromUFM_Directly s u)
89
90 delListFromUniqSet :: Uniquable a => UniqSet a -> [a] -> UniqSet a
91 delListFromUniqSet (UniqSet s) l = UniqSet (delListFromUFM s l)
92
93 delListFromUniqSet_Directly :: UniqSet a -> [Unique] -> UniqSet a
94 delListFromUniqSet_Directly (UniqSet s) l =
95 UniqSet (delListFromUFM_Directly s l)
96
97 unionUniqSets :: UniqSet a -> UniqSet a -> UniqSet a
98 unionUniqSets (UniqSet s) (UniqSet t) = UniqSet (plusUFM s t)
99
100 unionManyUniqSets :: [UniqSet a] -> UniqSet a
101 unionManyUniqSets = foldl' (flip unionUniqSets) emptyUniqSet
102
103 minusUniqSet :: UniqSet a -> UniqSet a -> UniqSet a
104 minusUniqSet (UniqSet s) (UniqSet t) = UniqSet (minusUFM s t)
105
106 intersectUniqSets :: UniqSet a -> UniqSet a -> UniqSet a
107 intersectUniqSets (UniqSet s) (UniqSet t) = UniqSet (intersectUFM s t)
108
109 disjointUniqSets :: UniqSet a -> UniqSet a -> Bool
110 disjointUniqSets (UniqSet s) (UniqSet t) = disjointUFM s t
111
112 restrictUniqSetToUFM :: UniqSet key -> UniqFM key b -> UniqSet key
113 restrictUniqSetToUFM (UniqSet s) m = UniqSet (intersectUFM s m)
114
115 uniqSetMinusUFM :: UniqSet key -> UniqFM key b -> UniqSet key
116 uniqSetMinusUFM (UniqSet s) t = UniqSet (minusUFM s t)
117
118 uniqSetMinusUDFM :: UniqSet key -> UniqDFM key b -> UniqSet key
119 uniqSetMinusUDFM (UniqSet s) t = UniqSet (ufmMinusUDFM s t)
120
121 elementOfUniqSet :: Uniquable a => a -> UniqSet a -> Bool
122 elementOfUniqSet a (UniqSet s) = elemUFM a s
123
124 elemUniqSet_Directly :: Unique -> UniqSet a -> Bool
125 elemUniqSet_Directly a (UniqSet s) = elemUFM_Directly a s
126
127 filterUniqSet :: (a -> Bool) -> UniqSet a -> UniqSet a
128 filterUniqSet p (UniqSet s) = UniqSet (filterUFM p s)
129
130 filterUniqSet_Directly :: (Unique -> elt -> Bool) -> UniqSet elt -> UniqSet elt
131 filterUniqSet_Directly f (UniqSet s) = UniqSet (filterUFM_Directly f s)
132
133 partitionUniqSet :: (a -> Bool) -> UniqSet a -> (UniqSet a, UniqSet a)
134 partitionUniqSet p (UniqSet s) = coerce (partitionUFM p s)
135
136 uniqSetAny :: (a -> Bool) -> UniqSet a -> Bool
137 uniqSetAny p (UniqSet s) = anyUFM p s
138
139 uniqSetAll :: (a -> Bool) -> UniqSet a -> Bool
140 uniqSetAll p (UniqSet s) = allUFM p s
141
142 sizeUniqSet :: UniqSet a -> Int
143 sizeUniqSet (UniqSet s) = sizeUFM s
144
145 isEmptyUniqSet :: UniqSet a -> Bool
146 isEmptyUniqSet (UniqSet s) = isNullUFM s
147
148 -- | What's the point you might ask? We might have changed an object
149 -- without it's key changing. In which case this lookup makes sense.
150 lookupUniqSet :: Uniquable key => UniqSet key -> key -> Maybe key
151 lookupUniqSet (UniqSet s) k = lookupUFM s k
152
153 lookupUniqSet_Directly :: UniqSet a -> Unique -> Maybe a
154 lookupUniqSet_Directly (UniqSet s) k = lookupUFM_Directly s k
155
156 -- See Note [Deterministic UniqFM] to learn about nondeterminism.
157 -- If you use this please provide a justification why it doesn't introduce
158 -- nondeterminism.
159 nonDetEltsUniqSet :: UniqSet elt -> [elt]
160 nonDetEltsUniqSet = nonDetEltsUFM . getUniqSet'
161
162 -- See Note [Deterministic UniqFM] to learn about nondeterminism.
163 -- If you use this please provide a justification why it doesn't introduce
164 -- nondeterminism.
165 nonDetKeysUniqSet :: UniqSet elt -> [Unique]
166 nonDetKeysUniqSet = nonDetKeysUFM . getUniqSet'
167
168 -- See Note [Deterministic UniqFM] to learn about nondeterminism.
169 -- If you use this please provide a justification why it doesn't introduce
170 -- nondeterminism.
171 nonDetStrictFoldUniqSet :: (elt -> a -> a) -> a -> UniqSet elt -> a
172 nonDetStrictFoldUniqSet c n (UniqSet s) = nonDetStrictFoldUFM c n s
173
174 -- See Note [UniqSet invariant]
175 mapUniqSet :: Uniquable b => (a -> b) -> UniqSet a -> UniqSet b
176 mapUniqSet f = mkUniqSet . map f . nonDetEltsUniqSet
177
178 -- Two 'UniqSet's are considered equal if they contain the same
179 -- uniques.
180 instance Eq (UniqSet a) where
181 UniqSet a == UniqSet b = equalKeysUFM a b
182
183 getUniqSet :: UniqSet a -> UniqFM a a
184 getUniqSet = getUniqSet'
185
186 -- | 'unsafeUFMToUniqSet' converts a @'UniqFM' a@ into a @'UniqSet' a@
187 -- assuming, without checking, that it maps each 'Unique' to a value
188 -- that has that 'Unique'. See Note [UniqSet invariant].
189 unsafeUFMToUniqSet :: UniqFM a a -> UniqSet a
190 unsafeUFMToUniqSet = UniqSet
191
192 instance Outputable a => Outputable (UniqSet a) where
193 ppr = pprUniqSet ppr
194
195 pprUniqSet :: (a -> SDoc) -> UniqSet a -> SDoc
196 -- It's OK to use nonDetUFMToList here because we only use it for
197 -- pretty-printing.
198 pprUniqSet f = braces . pprWithCommas f . nonDetEltsUniqSet