never executed always true always false
1 {-# LANGUAGE RoleAnnotations #-}
2 {-# LANGUAGE TupleSections #-}
3 {-# LANGUAGE DeriveDataTypeable #-}
4 {-# LANGUAGE DeriveFunctor #-}
5 {-# OPTIONS_GHC -Wall #-}
6
7 -- Like 'UniqFM', these are maps for keys which are Uniquable.
8 -- Unlike 'UniqFM', these maps also remember their keys, which
9 -- makes them a much better drop in replacement for 'Data.Map.Map'.
10 --
11 -- Key preservation is right-biased.
12 module GHC.Types.Unique.Map (
13 UniqMap(..),
14 emptyUniqMap,
15 isNullUniqMap,
16 unitUniqMap,
17 listToUniqMap,
18 listToUniqMap_C,
19 addToUniqMap,
20 addListToUniqMap,
21 addToUniqMap_C,
22 addToUniqMap_Acc,
23 alterUniqMap,
24 addListToUniqMap_C,
25 adjustUniqMap,
26 delFromUniqMap,
27 delListFromUniqMap,
28 plusUniqMap,
29 plusUniqMap_C,
30 plusMaybeUniqMap_C,
31 plusUniqMapList,
32 minusUniqMap,
33 intersectUniqMap,
34 disjointUniqMap,
35 mapUniqMap,
36 filterUniqMap,
37 partitionUniqMap,
38 sizeUniqMap,
39 elemUniqMap,
40 lookupUniqMap,
41 lookupWithDefaultUniqMap,
42 anyUniqMap,
43 allUniqMap,
44 -- Non-deterministic functions omitted
45 ) where
46
47 import GHC.Prelude
48
49 import GHC.Types.Unique.FM
50
51 import GHC.Types.Unique
52 import GHC.Utils.Outputable
53
54 import Data.Semigroup as Semi ( Semigroup(..) )
55 import Data.Coerce
56 import Data.Maybe
57 import Data.Data
58
59 -- | Maps indexed by 'Uniquable' keys
60 newtype UniqMap k a = UniqMap (UniqFM k (k, a))
61 deriving (Data, Eq, Functor)
62 type role UniqMap nominal representational
63
64 instance Semigroup (UniqMap k a) where
65 (<>) = plusUniqMap
66
67 instance Monoid (UniqMap k a) where
68 mempty = emptyUniqMap
69 mappend = (Semi.<>)
70
71 instance (Outputable k, Outputable a) => Outputable (UniqMap k a) where
72 ppr (UniqMap m) =
73 brackets $ fsep $ punctuate comma $
74 [ ppr k <+> text "->" <+> ppr v
75 | (k, v) <- nonDetEltsUFM m ]
76
77 liftC :: (a -> a -> a) -> (k, a) -> (k, a) -> (k, a)
78 liftC f (_, v) (k', v') = (k', f v v')
79
80 emptyUniqMap :: UniqMap k a
81 emptyUniqMap = UniqMap emptyUFM
82
83 isNullUniqMap :: UniqMap k a -> Bool
84 isNullUniqMap (UniqMap m) = isNullUFM m
85
86 unitUniqMap :: Uniquable k => k -> a -> UniqMap k a
87 unitUniqMap k v = UniqMap (unitUFM k (k, v))
88
89 listToUniqMap :: Uniquable k => [(k,a)] -> UniqMap k a
90 listToUniqMap kvs = UniqMap (listToUFM [ (k,(k,v)) | (k,v) <- kvs])
91
92 listToUniqMap_C :: Uniquable k => (a -> a -> a) -> [(k,a)] -> UniqMap k a
93 listToUniqMap_C f kvs = UniqMap $
94 listToUFM_C (liftC f) [ (k,(k,v)) | (k,v) <- kvs]
95
96 addToUniqMap :: Uniquable k => UniqMap k a -> k -> a -> UniqMap k a
97 addToUniqMap (UniqMap m) k v = UniqMap $ addToUFM m k (k, v)
98
99 addListToUniqMap :: Uniquable k => UniqMap k a -> [(k,a)] -> UniqMap k a
100 addListToUniqMap (UniqMap m) kvs = UniqMap $
101 addListToUFM m [(k,(k,v)) | (k,v) <- kvs]
102
103 addToUniqMap_C :: Uniquable k
104 => (a -> a -> a)
105 -> UniqMap k a
106 -> k
107 -> a
108 -> UniqMap k a
109 addToUniqMap_C f (UniqMap m) k v = UniqMap $
110 addToUFM_C (liftC f) m k (k, v)
111
112 addToUniqMap_Acc :: Uniquable k
113 => (b -> a -> a)
114 -> (b -> a)
115 -> UniqMap k a
116 -> k
117 -> b
118 -> UniqMap k a
119 addToUniqMap_Acc exi new (UniqMap m) k0 v0 = UniqMap $
120 addToUFM_Acc (\b (k, v) -> (k, exi b v))
121 (\b -> (k0, new b))
122 m k0 v0
123
124 alterUniqMap :: Uniquable k
125 => (Maybe a -> Maybe a)
126 -> UniqMap k a
127 -> k
128 -> UniqMap k a
129 alterUniqMap f (UniqMap m) k = UniqMap $
130 alterUFM (fmap (k,) . f . fmap snd) m k
131
132 addListToUniqMap_C
133 :: Uniquable k
134 => (a -> a -> a)
135 -> UniqMap k a
136 -> [(k, a)]
137 -> UniqMap k a
138 addListToUniqMap_C f (UniqMap m) kvs = UniqMap $
139 addListToUFM_C (liftC f) m
140 [(k,(k,v)) | (k,v) <- kvs]
141
142 adjustUniqMap
143 :: Uniquable k
144 => (a -> a)
145 -> UniqMap k a
146 -> k
147 -> UniqMap k a
148 adjustUniqMap f (UniqMap m) k = UniqMap $
149 adjustUFM (\(_,v) -> (k,f v)) m k
150
151 delFromUniqMap :: Uniquable k => UniqMap k a -> k -> UniqMap k a
152 delFromUniqMap (UniqMap m) k = UniqMap $ delFromUFM m k
153
154 delListFromUniqMap :: Uniquable k => UniqMap k a -> [k] -> UniqMap k a
155 delListFromUniqMap (UniqMap m) ks = UniqMap $ delListFromUFM m ks
156
157 plusUniqMap :: UniqMap k a -> UniqMap k a -> UniqMap k a
158 plusUniqMap (UniqMap m1) (UniqMap m2) = UniqMap $ plusUFM m1 m2
159
160 plusUniqMap_C :: (a -> a -> a) -> UniqMap k a -> UniqMap k a -> UniqMap k a
161 plusUniqMap_C f (UniqMap m1) (UniqMap m2) = UniqMap $
162 plusUFM_C (liftC f) m1 m2
163
164 plusMaybeUniqMap_C :: (a -> a -> Maybe a) -> UniqMap k a -> UniqMap k a -> UniqMap k a
165 plusMaybeUniqMap_C f (UniqMap m1) (UniqMap m2) = UniqMap $
166 plusMaybeUFM_C (\(_, v) (k', v') -> fmap (k',) (f v v')) m1 m2
167
168 plusUniqMapList :: [UniqMap k a] -> UniqMap k a
169 plusUniqMapList xs = UniqMap $ plusUFMList (coerce xs)
170
171 minusUniqMap :: UniqMap k a -> UniqMap k b -> UniqMap k a
172 minusUniqMap (UniqMap m1) (UniqMap m2) = UniqMap $ minusUFM m1 m2
173
174 intersectUniqMap :: UniqMap k a -> UniqMap k b -> UniqMap k a
175 intersectUniqMap (UniqMap m1) (UniqMap m2) = UniqMap $ intersectUFM m1 m2
176
177 disjointUniqMap :: UniqMap k a -> UniqMap k b -> Bool
178 disjointUniqMap (UniqMap m1) (UniqMap m2) = disjointUFM m1 m2
179
180 mapUniqMap :: (a -> b) -> UniqMap k a -> UniqMap k b
181 mapUniqMap f (UniqMap m) = UniqMap $ mapUFM (fmap f) m -- (,) k instance
182
183 filterUniqMap :: (a -> Bool) -> UniqMap k a -> UniqMap k a
184 filterUniqMap f (UniqMap m) = UniqMap $ filterUFM (f . snd) m
185
186 partitionUniqMap :: (a -> Bool) -> UniqMap k a -> (UniqMap k a, UniqMap k a)
187 partitionUniqMap f (UniqMap m) =
188 coerce $ partitionUFM (f . snd) m
189
190 sizeUniqMap :: UniqMap k a -> Int
191 sizeUniqMap (UniqMap m) = sizeUFM m
192
193 elemUniqMap :: Uniquable k => k -> UniqMap k a -> Bool
194 elemUniqMap k (UniqMap m) = elemUFM k m
195
196 lookupUniqMap :: Uniquable k => UniqMap k a -> k -> Maybe a
197 lookupUniqMap (UniqMap m) k = fmap snd (lookupUFM m k)
198
199 lookupWithDefaultUniqMap :: Uniquable k => UniqMap k a -> a -> k -> a
200 lookupWithDefaultUniqMap (UniqMap m) a k = fromMaybe a (fmap snd (lookupUFM m k))
201
202 anyUniqMap :: (a -> Bool) -> UniqMap k a -> Bool
203 anyUniqMap f (UniqMap m) = anyUFM (f . snd) m
204
205 allUniqMap :: (a -> Bool) -> UniqMap k a -> Bool
206 allUniqMap f (UniqMap m) = allUFM (f . snd) m