2 % (c) The University of Glasgow 2006
3 % (c) The AQUA Project, Glasgow University, 1994-1998
6 LazyUniqFM: Specialised lazy finite maps, for things with @Uniques@
10 Basically, the things need to be in class @Uniquable@, and we use the
11 @getUnique@ method to grab their @Uniques@.
15 -- * Lazy unique-keyed mappings
16 UniqFM, -- abstract type
18 -- ** Manipulating those mappings
24 addToUFM,addToUFM_C,addToUFM_Acc,
25 addListToUFM,addListToUFM_C,
27 addListToUFM_Directly,
37 foldUFM, foldUFM_Directly,
39 elemUFM, elemUFM_Directly,
40 filterUFM, filterUFM_Directly,
44 lookupUFM, lookupUFM_Directly,
45 lookupWithDefaultUFM, lookupWithDefaultUFM_Directly,
50 import qualified UniqFM as S
56 %************************************************************************
58 \subsection{The @UniqFM@ type, and signatures for the functions}
60 %************************************************************************
62 We use @FiniteMaps@, with a (@getUnique@-able) @Unique@ as ``key''.
65 emptyUFM :: UniqFM elt
66 isNullUFM :: UniqFM elt -> Bool
67 unitUFM :: Uniquable key => key -> elt -> UniqFM elt
68 unitDirectlyUFM -- got the Unique already
69 :: Unique -> elt -> UniqFM elt
70 listToUFM :: Uniquable key => [(key,elt)] -> UniqFM elt
72 :: [(Unique, elt)] -> UniqFM elt
74 addToUFM :: Uniquable key => UniqFM elt -> key -> elt -> UniqFM elt
75 addListToUFM :: Uniquable key => UniqFM elt -> [(key,elt)] -> UniqFM elt
76 addListToUFM_Directly :: UniqFM elt -> [(Unique,elt)] -> UniqFM elt
78 :: UniqFM elt -> Unique -> elt -> UniqFM elt
80 addToUFM_C :: Uniquable key => (elt -> elt -> elt) -- old -> new -> result
83 -> UniqFM elt -- result
85 addToUFM_Acc :: Uniquable key =>
86 (elt -> elts -> elts) -- Add to existing
87 -> (elt -> elts) -- New element
90 -> UniqFM elts -- result
92 addListToUFM_C :: Uniquable key => (elt -> elt -> elt)
93 -> UniqFM elt -> [(key,elt)]
96 delFromUFM :: Uniquable key => UniqFM elt -> key -> UniqFM elt
97 delListFromUFM :: Uniquable key => UniqFM elt -> [key] -> UniqFM elt
98 delFromUFM_Directly :: UniqFM elt -> Unique -> UniqFM elt
100 plusUFM :: UniqFM elt -> UniqFM elt -> UniqFM elt
102 plusUFM_C :: (elt -> elt -> elt)
103 -> UniqFM elt -> UniqFM elt -> UniqFM elt
105 minusUFM :: UniqFM elt1 -> UniqFM elt2 -> UniqFM elt1
107 intersectUFM :: UniqFM elt -> UniqFM elt -> UniqFM elt
108 intersectUFM_C :: (elt1 -> elt2 -> elt3)
109 -> UniqFM elt1 -> UniqFM elt2 -> UniqFM elt3
110 intersectsUFM :: UniqFM elt1 -> UniqFM elt2 -> Bool
112 foldUFM :: (elt -> a -> a) -> a -> UniqFM elt -> a
113 foldUFM_Directly:: (Unique -> elt -> a -> a) -> a -> UniqFM elt -> a
114 mapUFM :: (elt1 -> elt2) -> UniqFM elt1 -> UniqFM elt2
115 filterUFM :: (elt -> Bool) -> UniqFM elt -> UniqFM elt
116 filterUFM_Directly :: (Unique -> elt -> Bool) -> UniqFM elt -> UniqFM elt
118 sizeUFM :: UniqFM elt -> Int
119 hashUFM :: UniqFM elt -> Int
120 elemUFM :: Uniquable key => key -> UniqFM elt -> Bool
121 elemUFM_Directly:: Unique -> UniqFM elt -> Bool
123 lookupUFM :: Uniquable key => UniqFM elt -> key -> Maybe elt
124 lookupUFM_Directly -- when you've got the Unique already
125 :: UniqFM elt -> Unique -> Maybe elt
127 :: Uniquable key => UniqFM elt -> elt -> key -> elt
128 lookupWithDefaultUFM_Directly
129 :: UniqFM elt -> elt -> Unique -> elt
131 keysUFM :: UniqFM elt -> [Unique] -- Get the keys
132 eltsUFM :: UniqFM elt -> [elt]
133 ufmToList :: UniqFM elt -> [(Unique, elt)]
136 %************************************************************************
138 \subsection{The @IdFinMap@ and @TyVarFinMap@ specialisations for Ids/TyVars}
140 %************************************************************************
143 -- Turn off for now, these need to be updated (SDM 4/98)
146 #ifdef __GLASGOW_HASKELL__
147 -- I don't think HBC was too happy about this (WDP 94/10)
150 addListToUFM :: UniqFM elt -> [(Name, elt)] -> UniqFM elt
153 addListToUFM_C :: (elt -> elt -> elt) -> UniqFM elt -> [(Name, elt)] -> UniqFM elt
156 addToUFM :: UniqFM elt -> Unique -> elt -> UniqFM elt
159 listToUFM :: [(Unique, elt)] -> UniqFM elt
162 lookupUFM :: UniqFM elt -> Name -> Maybe elt
163 , UniqFM elt -> Unique -> Maybe elt
166 #endif /* __GLASGOW_HASKELL__ */
170 %************************************************************************
172 \subsubsection{The @UniqFM@ type, and signatures for the functions}
174 %************************************************************************
176 @UniqFM a@ is a mapping from Unique to a.
179 data Lazy a = Lazy { fromLazy :: a }
181 -- | @UniqFM a@ is a mapping from Unique to @a@ where the element @a@ is evaluated lazily.
182 newtype UniqFM ele = MkUniqFM (S.UniqFM (Lazy ele))
184 instance Outputable a => Outputable (UniqFM a) where
185 ppr (MkUniqFM fm) = ppr fm
187 instance Outputable a => Outputable (Lazy a) where
191 %************************************************************************
193 \subsubsection{The @UniqFM@ functions}
195 %************************************************************************
197 First the ways of building a UniqFM.
200 emptyUFM = MkUniqFM $ S.EmptyUFM
201 unitUFM key elt = MkUniqFM $ S.unitUFM key (Lazy elt)
202 unitDirectlyUFM key elt = MkUniqFM $ S.unitDirectlyUFM key (Lazy elt)
204 listToUFM key_elt_pairs
205 = MkUniqFM $ S.listToUFM [ (k, Lazy v) | (k, v) <- key_elt_pairs ]
206 listToUFM_Directly uniq_elt_pairs
208 $ S.listToUFM_Directly [ (k, Lazy v) | (k, v) <- uniq_elt_pairs ]
211 Now ways of adding things to UniqFMs.
213 There is an alternative version of @addListToUFM_C@, that uses @plusUFM@,
214 but the semantics of this operation demands a linear insertion;
215 perhaps the version without the combinator function
216 could be optimised using it.
219 addToUFM (MkUniqFM fm) key elt = MkUniqFM $ S.addToUFM fm key (Lazy elt)
221 addToUFM_Directly (MkUniqFM fm) u elt
222 = MkUniqFM $ S.addToUFM_Directly fm u (Lazy elt)
224 addToUFM_C combiner (MkUniqFM fm) key elt
225 = MkUniqFM $ S.addToUFM_C combiner' fm key (Lazy elt)
226 where combiner' (Lazy l) (Lazy r) = Lazy (combiner l r)
228 addToUFM_Acc add unit (MkUniqFM fm) key item
229 = MkUniqFM $ S.addToUFM_Acc add' unit' fm key item
230 where add' elt (Lazy elts) = Lazy (add elt elts)
231 unit' elt = Lazy (unit elt)
233 addListToUFM (MkUniqFM fm) key_elt_pairs
234 = MkUniqFM $ S.addListToUFM fm [ (k, Lazy v) | (k, v) <- key_elt_pairs ]
235 addListToUFM_Directly (MkUniqFM fm) uniq_elt_pairs
237 $ S.addListToUFM_Directly fm [ (k, Lazy v) | (k, v) <- uniq_elt_pairs ]
239 addListToUFM_C combiner (MkUniqFM fm) key_elt_pairs
241 $ S.addListToUFM_C combiner' fm [ (k, Lazy v) | (k, v) <- key_elt_pairs ]
242 where combiner' (Lazy l) (Lazy r) = Lazy (combiner l r)
245 Now ways of removing things from UniqFM.
248 delListFromUFM (MkUniqFM fm) lst = MkUniqFM $ S.delListFromUFM fm lst
250 delFromUFM (MkUniqFM fm) key = MkUniqFM $ S.delFromUFM fm key
251 delFromUFM_Directly (MkUniqFM fm) u = MkUniqFM $ S.delFromUFM_Directly fm u
254 Now ways of adding two UniqFM's together.
257 plusUFM (MkUniqFM tr1) (MkUniqFM tr2) = MkUniqFM $ S.plusUFM tr1 tr2
259 plusUFM_C f (MkUniqFM tr1) (MkUniqFM tr2) = MkUniqFM $ S.plusUFM_C f' tr1 tr2
260 where f' (Lazy l) (Lazy r) = Lazy $ f l r
263 And ways of subtracting them. First the base cases,
264 then the full D&C approach.
267 minusUFM (MkUniqFM fm1) (MkUniqFM fm2) = MkUniqFM $ S.minusUFM fm1 fm2
270 And taking the intersection of two UniqFM's.
273 intersectUFM (MkUniqFM t1) (MkUniqFM t2) = MkUniqFM $ S.intersectUFM t1 t2
274 intersectsUFM (MkUniqFM t1) (MkUniqFM t2) = S.intersectsUFM t1 t2
276 intersectUFM_C f (MkUniqFM fm1) (MkUniqFM fm2)
277 = MkUniqFM $ S.intersectUFM_C f' fm1 fm2
278 where f' (Lazy l) (Lazy r) = Lazy $ f l r
281 Now the usual set of `collection' operators, like map, fold, etc.
284 foldUFM f a (MkUniqFM ufm) = S.foldUFM f' a ufm
285 where f' (Lazy elt) x = f elt x
289 mapUFM fn (MkUniqFM fm) = MkUniqFM (S.mapUFM fn' fm)
290 where fn' (Lazy elt) = Lazy (fn elt)
292 filterUFM fn (MkUniqFM fm) = MkUniqFM (S.filterUFM fn' fm)
293 where fn' (Lazy elt) = fn elt
295 filterUFM_Directly fn (MkUniqFM fm) = MkUniqFM $ S.filterUFM_Directly fn' fm
296 where fn' u (Lazy elt) = fn u elt
299 Note, this takes a long time, O(n), but
300 because we dont want to do this very often, we put up with this.
301 O'rable, but how often do we look at the size of
305 sizeUFM (MkUniqFM fm) = S.sizeUFM fm
307 isNullUFM (MkUniqFM fm) = S.isNullUFM fm
309 -- hashing is used in VarSet.uniqAway, and should be fast
310 -- We use a cheap and cheerful method for now
311 hashUFM (MkUniqFM fm) = S.hashUFM fm
314 looking up in a hurry is the {\em whole point} of this binary tree lark.
315 Lookup up a binary tree is easy (and fast).
318 elemUFM key (MkUniqFM fm) = S.elemUFM key fm
319 elemUFM_Directly key (MkUniqFM fm) = S.elemUFM_Directly key fm
321 lookupUFM (MkUniqFM fm) key = fmap fromLazy $ S.lookupUFM fm key
322 lookupUFM_Directly (MkUniqFM fm) key
323 = fmap fromLazy $ S.lookupUFM_Directly fm key
325 lookupWithDefaultUFM (MkUniqFM fm) deflt key
326 = fromLazy $ S.lookupWithDefaultUFM fm (Lazy deflt) key
328 lookupWithDefaultUFM_Directly (MkUniqFM fm) deflt key
329 = fromLazy $ S.lookupWithDefaultUFM_Directly fm (Lazy deflt) key
332 folds are *wonderful* things.
335 eltsUFM (MkUniqFM fm) = map fromLazy $ S.eltsUFM fm
336 keysUFM (MkUniqFM fm) = S.keysUFM fm
337 ufmToList (MkUniqFM fm) = [ (k, v) | (k, Lazy v) <- S.ufmToList fm ]
338 foldUFM_Directly f elt (MkUniqFM fm)
339 = S.foldUFM_Directly f' elt fm
340 where f' u (Lazy elt') x = f u elt' x