2 % (c) The University of Glasgow 2006
3 % (c) The AQUA Project, Glasgow University, 1994-1998
6 UniqFM: Specialised finite maps, for things with @Uniques@.
8 Basically, the things need to be in class @Uniquable@, and we use the
9 @getUnique@ method to grab their @Uniques@.
11 (A similar thing to @UniqSet@, as opposed to @Set@.)
13 The interface is based on @FiniteMap@s, but the implementation uses
14 @Data.IntMap@, which is both maitained and faster than the past
15 implementation (see commit log).
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.
25 -- * Unique-keyed mappings
26 UniqFM, -- abstract type
28 -- ** Manipulating those mappings
35 addToUFM,addToUFM_C,addToUFM_Acc,
36 addListToUFM,addListToUFM_C,
38 addListToUFM_Directly,
49 foldUFM, foldUFM_Directly,
50 mapUFM, mapUFM_Directly,
51 elemUFM, elemUFM_Directly,
52 filterUFM, filterUFM_Directly,
55 lookupUFM, lookupUFM_Directly,
56 lookupWithDefaultUFM, lookupWithDefaultUFM_Directly,
57 eltsUFM, keysUFM, splitUFM,
62 import Unique ( Uniquable(..), Unique, getKey )
65 import Compiler.Hoopl hiding (Unique)
67 import qualified Data.IntMap as M
70 %************************************************************************
72 \subsection{The signature of the module}
74 %************************************************************************
77 emptyUFM :: UniqFM elt
78 isNullUFM :: UniqFM elt -> Bool
79 unitUFM :: Uniquable key => key -> elt -> UniqFM elt
80 unitDirectlyUFM -- got the Unique already
81 :: Unique -> elt -> UniqFM elt
82 listToUFM :: Uniquable key => [(key,elt)] -> UniqFM elt
84 :: [(Unique, elt)] -> UniqFM elt
85 listToUFM_C :: Uniquable key => (elt -> elt -> elt)
89 addToUFM :: Uniquable key => UniqFM elt -> key -> elt -> UniqFM elt
90 addListToUFM :: Uniquable key => UniqFM elt -> [(key,elt)] -> UniqFM elt
91 addListToUFM_Directly :: UniqFM elt -> [(Unique,elt)] -> UniqFM elt
93 :: UniqFM elt -> Unique -> elt -> UniqFM elt
95 addToUFM_C :: Uniquable key => (elt -> elt -> elt) -- old -> new -> result
98 -> UniqFM elt -- result
100 addToUFM_Acc :: Uniquable key =>
101 (elt -> elts -> elts) -- Add to existing
102 -> (elt -> elts) -- New element
103 -> UniqFM elts -- old
105 -> UniqFM elts -- result
107 addListToUFM_C :: Uniquable key => (elt -> elt -> elt)
108 -> UniqFM elt -> [(key,elt)]
111 adjustUFM :: Uniquable key => (elt -> elt) -> UniqFM elt -> key -> UniqFM elt
112 adjustUFM_Directly :: (elt -> elt) -> UniqFM elt -> Unique -> UniqFM elt
114 delFromUFM :: Uniquable key => UniqFM elt -> key -> UniqFM elt
115 delListFromUFM :: Uniquable key => UniqFM elt -> [key] -> UniqFM elt
116 delFromUFM_Directly :: UniqFM elt -> Unique -> UniqFM elt
118 -- Bindings in right argument shadow those in the left
119 plusUFM :: UniqFM elt -> UniqFM elt -> UniqFM elt
121 plusUFM_C :: (elt -> elt -> elt)
122 -> UniqFM elt -> UniqFM elt -> UniqFM elt
124 minusUFM :: UniqFM elt1 -> UniqFM elt2 -> UniqFM elt1
126 intersectUFM :: UniqFM elt -> UniqFM elt -> UniqFM elt
127 intersectUFM_C :: (elt1 -> elt2 -> elt3)
128 -> UniqFM elt1 -> UniqFM elt2 -> UniqFM elt3
130 foldUFM :: (elt -> a -> a) -> a -> UniqFM elt -> a
131 foldUFM_Directly:: (Unique -> elt -> a -> a) -> a -> UniqFM elt -> a
132 mapUFM :: (elt1 -> elt2) -> UniqFM elt1 -> UniqFM elt2
133 mapUFM_Directly :: (Unique -> elt1 -> elt2) -> UniqFM elt1 -> UniqFM elt2
134 filterUFM :: (elt -> Bool) -> UniqFM elt -> UniqFM elt
135 filterUFM_Directly :: (Unique -> elt -> Bool) -> UniqFM elt -> UniqFM elt
137 sizeUFM :: UniqFM elt -> Int
138 --hashUFM :: UniqFM elt -> Int
139 elemUFM :: Uniquable key => key -> UniqFM elt -> Bool
140 elemUFM_Directly:: Unique -> UniqFM elt -> Bool
142 splitUFM :: Uniquable key => UniqFM elt -> key -> (UniqFM elt, Maybe elt, UniqFM elt)
143 -- Splits a UFM into things less than, equal to, and greater than the key
144 lookupUFM :: Uniquable key => UniqFM elt -> key -> Maybe elt
145 lookupUFM_Directly -- when you've got the Unique already
146 :: UniqFM elt -> Unique -> Maybe elt
148 :: Uniquable key => UniqFM elt -> elt -> key -> elt
149 lookupWithDefaultUFM_Directly
150 :: UniqFM elt -> elt -> Unique -> elt
151 keysUFM :: UniqFM elt -> [Unique] -- Get the keys
152 eltsUFM :: UniqFM elt -> [elt]
153 ufmToList :: UniqFM elt -> [(Unique, elt)]
157 %************************************************************************
159 \subsection{Implementation using ``Data.IntMap''}
161 %************************************************************************
164 newtype UniqFM ele = UFM (M.IntMap ele)
166 emptyUFM = UFM M.empty
167 isNullUFM (UFM m) = M.null m
168 unitUFM k v = UFM (M.singleton (getKey $ getUnique k) v)
169 unitDirectlyUFM u v = UFM (M.singleton (getKey u) v)
170 listToUFM = foldl (\m (k, v) -> addToUFM m k v) emptyUFM
171 listToUFM_Directly = foldl (\m (u, v) -> addToUFM_Directly m u v) emptyUFM
172 listToUFM_C f = foldl (\m (k, v) -> addToUFM_C f m k v) emptyUFM
174 addToUFM (UFM m) k v = UFM (M.insert (getKey $ getUnique k) v m)
175 addListToUFM = foldl (\m (k, v) -> addToUFM m k v)
176 addListToUFM_Directly = foldl (\m (k, v) -> addToUFM_Directly m k v)
177 addToUFM_Directly (UFM m) u v = UFM (M.insert (getKey u) v m)
179 -- Arguments of combining function of M.insertWith and addToUFM_C are flipped.
180 addToUFM_C f (UFM m) k v =
181 UFM (M.insertWith (flip f) (getKey $ getUnique k) v m)
182 addToUFM_Acc exi new (UFM m) k v =
183 UFM (M.insertWith (\_new old -> exi v old) (getKey $ getUnique k) (new v) m)
184 addListToUFM_C f = foldl (\m (k, v) -> addToUFM_C f m k v)
186 adjustUFM f (UFM m) k = UFM (M.adjust f (getKey $ getUnique k) m)
187 adjustUFM_Directly f (UFM m) u = UFM (M.adjust f (getKey u) m)
189 delFromUFM (UFM m) k = UFM (M.delete (getKey $ getUnique k) m)
190 delListFromUFM = foldl delFromUFM
191 delFromUFM_Directly (UFM m) u = UFM (M.delete (getKey u) m)
193 -- M.union is left-biased, plusUFM should be right-biased.
194 plusUFM (UFM x) (UFM y) = UFM (M.union y x)
195 plusUFM_C f (UFM x) (UFM y) = UFM (M.unionWith f x y)
196 minusUFM (UFM x) (UFM y) = UFM (M.difference x y)
197 intersectUFM (UFM x) (UFM y) = UFM (M.intersection x y)
198 intersectUFM_C f (UFM x) (UFM y) = UFM (M.intersectionWith f x y)
200 foldUFM k z (UFM m) = M.fold k z m
201 foldUFM_Directly k z (UFM m) = M.foldWithKey (k . getUnique) z m
202 mapUFM f (UFM m) = UFM (M.map f m)
203 mapUFM_Directly f (UFM m) = UFM (M.mapWithKey (f . getUnique) m)
204 filterUFM p (UFM m) = UFM (M.filter p m)
205 filterUFM_Directly p (UFM m) = UFM (M.filterWithKey (p . getUnique) m)
207 sizeUFM (UFM m) = M.size m
208 elemUFM k (UFM m) = M.member (getKey $ getUnique k) m
209 elemUFM_Directly u (UFM m) = M.member (getKey u) m
211 splitUFM (UFM m) k = case M.splitLookup (getKey $ getUnique k) m of
212 (less, equal, greater) -> (UFM less, equal, UFM greater)
213 lookupUFM (UFM m) k = M.lookup (getKey $ getUnique k) m
214 lookupUFM_Directly (UFM m) u = M.lookup (getKey u) m
215 lookupWithDefaultUFM (UFM m) v k = M.findWithDefault v (getKey $ getUnique k) m
216 lookupWithDefaultUFM_Directly (UFM m) v u = M.findWithDefault v (getKey u) m
217 keysUFM (UFM m) = map getUnique $ M.keys m
218 eltsUFM (UFM m) = M.elems m
219 ufmToList (UFM m) = map (\(k, v) -> (getUnique k, v)) $ M.toList m
222 joinUFM :: JoinFun v -> JoinFun (UniqFM v)
223 joinUFM eltJoin l (OldFact old) (NewFact new) = foldUFM_Directly add (NoChange, old) new
224 where add k new_v (ch, joinmap) =
225 case lookupUFM_Directly joinmap k of
226 Nothing -> (SomeChange, addToUFM_Directly joinmap k new_v)
227 Just old_v -> case eltJoin l (OldFact old_v) (NewFact new_v) of
228 (SomeChange, v') -> (SomeChange, addToUFM_Directly joinmap k v')
229 (NoChange, _) -> (ch, joinmap)
233 %************************************************************************
235 \subsection{Output-ery}
237 %************************************************************************
240 instance Outputable a => Outputable (UniqFM a) where
241 ppr ufm = ppr (ufmToList ufm)