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@.
14 {-# OPTIONS -Wall -fno-warn-name-shadowing -Werror #-}
16 -- * Lazy unique-keyed mappings
17 UniqFM, -- abstract type
19 -- ** Manipulating those mappings
25 addToUFM,addToUFM_C,addToUFM_Acc,
26 addListToUFM,addListToUFM_C,
28 addListToUFM_Directly,
38 foldUFM, foldUFM_Directly,
40 elemUFM, elemUFM_Directly,
41 filterUFM, filterUFM_Directly,
45 lookupUFM, lookupUFM_Directly,
46 lookupWithDefaultUFM, lookupWithDefaultUFM_Directly,
51 import qualified UniqFM as S
57 %************************************************************************
59 \subsection{The @UniqFM@ type, and signatures for the functions}
61 %************************************************************************
63 We use @FiniteMaps@, with a (@getUnique@-able) @Unique@ as ``key''.
66 emptyUFM :: UniqFM elt
67 isNullUFM :: UniqFM elt -> Bool
68 unitUFM :: Uniquable key => key -> elt -> UniqFM elt
69 unitDirectlyUFM -- got the Unique already
70 :: Unique -> elt -> UniqFM elt
71 listToUFM :: Uniquable key => [(key,elt)] -> UniqFM elt
73 :: [(Unique, elt)] -> UniqFM elt
75 addToUFM :: Uniquable key => UniqFM elt -> key -> elt -> UniqFM elt
76 addListToUFM :: Uniquable key => UniqFM elt -> [(key,elt)] -> UniqFM elt
77 addListToUFM_Directly :: UniqFM elt -> [(Unique,elt)] -> UniqFM elt
79 :: UniqFM elt -> Unique -> elt -> UniqFM elt
81 addToUFM_C :: Uniquable key => (elt -> elt -> elt) -- old -> new -> result
84 -> UniqFM elt -- result
86 addToUFM_Acc :: Uniquable key =>
87 (elt -> elts -> elts) -- Add to existing
88 -> (elt -> elts) -- New element
91 -> UniqFM elts -- result
93 addListToUFM_C :: Uniquable key => (elt -> elt -> elt)
94 -> UniqFM elt -> [(key,elt)]
97 delFromUFM :: Uniquable key => UniqFM elt -> key -> UniqFM elt
98 delListFromUFM :: Uniquable key => UniqFM elt -> [key] -> UniqFM elt
99 delFromUFM_Directly :: UniqFM elt -> Unique -> UniqFM elt
101 plusUFM :: UniqFM elt -> UniqFM elt -> UniqFM elt
103 plusUFM_C :: (elt -> elt -> elt)
104 -> UniqFM elt -> UniqFM elt -> UniqFM elt
106 minusUFM :: UniqFM elt1 -> UniqFM elt2 -> UniqFM elt1
108 intersectUFM :: UniqFM elt -> UniqFM elt -> UniqFM elt
109 intersectUFM_C :: (elt1 -> elt2 -> elt3)
110 -> UniqFM elt1 -> UniqFM elt2 -> UniqFM elt3
111 intersectsUFM :: UniqFM elt1 -> UniqFM elt2 -> Bool
113 foldUFM :: (elt -> a -> a) -> a -> UniqFM elt -> a
114 foldUFM_Directly:: (Unique -> elt -> a -> a) -> a -> UniqFM elt -> a
115 mapUFM :: (elt1 -> elt2) -> UniqFM elt1 -> UniqFM elt2
116 filterUFM :: (elt -> Bool) -> UniqFM elt -> UniqFM elt
117 filterUFM_Directly :: (Unique -> elt -> Bool) -> UniqFM elt -> UniqFM elt
119 sizeUFM :: UniqFM elt -> Int
120 hashUFM :: UniqFM elt -> Int
121 elemUFM :: Uniquable key => key -> UniqFM elt -> Bool
122 elemUFM_Directly:: Unique -> UniqFM elt -> Bool
124 lookupUFM :: Uniquable key => UniqFM elt -> key -> Maybe elt
125 lookupUFM_Directly -- when you've got the Unique already
126 :: UniqFM elt -> Unique -> Maybe elt
128 :: Uniquable key => UniqFM elt -> elt -> key -> elt
129 lookupWithDefaultUFM_Directly
130 :: UniqFM elt -> elt -> Unique -> elt
132 keysUFM :: UniqFM elt -> [Unique] -- Get the keys
133 eltsUFM :: UniqFM elt -> [elt]
134 ufmToList :: UniqFM elt -> [(Unique, elt)]
137 %************************************************************************
139 \subsection{The @IdFinMap@ and @TyVarFinMap@ specialisations for Ids/TyVars}
141 %************************************************************************
144 -- Turn off for now, these need to be updated (SDM 4/98)
147 #ifdef __GLASGOW_HASKELL__
148 -- I don't think HBC was too happy about this (WDP 94/10)
151 addListToUFM :: UniqFM elt -> [(Name, elt)] -> UniqFM elt
154 addListToUFM_C :: (elt -> elt -> elt) -> UniqFM elt -> [(Name, elt)] -> UniqFM elt
157 addToUFM :: UniqFM elt -> Unique -> elt -> UniqFM elt
160 listToUFM :: [(Unique, elt)] -> UniqFM elt
163 lookupUFM :: UniqFM elt -> Name -> Maybe elt
164 , UniqFM elt -> Unique -> Maybe elt
167 #endif /* __GLASGOW_HASKELL__ */
171 %************************************************************************
173 \subsubsection{The @UniqFM@ type, and signatures for the functions}
175 %************************************************************************
177 @UniqFM a@ is a mapping from Unique to a.
180 data Lazy a = Lazy { fromLazy :: a }
182 -- | @UniqFM a@ is a mapping from Unique to @a@ where the element @a@ is evaluated lazily.
183 newtype UniqFM ele = MkUniqFM (S.UniqFM (Lazy ele))
185 instance Outputable a => Outputable (UniqFM a) where
186 ppr (MkUniqFM fm) = ppr fm
188 instance Outputable a => Outputable (Lazy a) where
192 %************************************************************************
194 \subsubsection{The @UniqFM@ functions}
196 %************************************************************************
198 First the ways of building a UniqFM.
201 emptyUFM = MkUniqFM $ S.EmptyUFM
202 unitUFM key elt = MkUniqFM $ S.unitUFM key (Lazy elt)
203 unitDirectlyUFM key elt = MkUniqFM $ S.unitDirectlyUFM key (Lazy elt)
205 listToUFM key_elt_pairs
206 = MkUniqFM $ S.listToUFM [ (k, Lazy v) | (k, v) <- key_elt_pairs ]
207 listToUFM_Directly uniq_elt_pairs
209 $ S.listToUFM_Directly [ (k, Lazy v) | (k, v) <- uniq_elt_pairs ]
212 Now ways of adding things to UniqFMs.
214 There is an alternative version of @addListToUFM_C@, that uses @plusUFM@,
215 but the semantics of this operation demands a linear insertion;
216 perhaps the version without the combinator function
217 could be optimised using it.
220 addToUFM (MkUniqFM fm) key elt = MkUniqFM $ S.addToUFM fm key (Lazy elt)
222 addToUFM_Directly (MkUniqFM fm) u elt
223 = MkUniqFM $ S.addToUFM_Directly fm u (Lazy elt)
225 addToUFM_C combiner (MkUniqFM fm) key elt
226 = MkUniqFM $ S.addToUFM_C combiner' fm key (Lazy elt)
227 where combiner' (Lazy l) (Lazy r) = Lazy (combiner l r)
229 addToUFM_Acc add unit (MkUniqFM fm) key item
230 = MkUniqFM $ S.addToUFM_Acc add' unit' fm key item
231 where add' elt (Lazy elts) = Lazy (add elt elts)
232 unit' elt = Lazy (unit elt)
234 addListToUFM (MkUniqFM fm) key_elt_pairs
235 = MkUniqFM $ S.addListToUFM fm [ (k, Lazy v) | (k, v) <- key_elt_pairs ]
236 addListToUFM_Directly (MkUniqFM fm) uniq_elt_pairs
238 $ S.addListToUFM_Directly fm [ (k, Lazy v) | (k, v) <- uniq_elt_pairs ]
240 addListToUFM_C combiner (MkUniqFM fm) key_elt_pairs
242 $ S.addListToUFM_C combiner' fm [ (k, Lazy v) | (k, v) <- key_elt_pairs ]
243 where combiner' (Lazy l) (Lazy r) = Lazy (combiner l r)
246 Now ways of removing things from UniqFM.
249 delListFromUFM (MkUniqFM fm) lst = MkUniqFM $ S.delListFromUFM fm lst
251 delFromUFM (MkUniqFM fm) key = MkUniqFM $ S.delFromUFM fm key
252 delFromUFM_Directly (MkUniqFM fm) u = MkUniqFM $ S.delFromUFM_Directly fm u
255 Now ways of adding two UniqFM's together.
258 plusUFM (MkUniqFM tr1) (MkUniqFM tr2) = MkUniqFM $ S.plusUFM tr1 tr2
260 plusUFM_C f (MkUniqFM tr1) (MkUniqFM tr2) = MkUniqFM $ S.plusUFM_C f' tr1 tr2
261 where f' (Lazy l) (Lazy r) = Lazy $ f l r
264 And ways of subtracting them. First the base cases,
265 then the full D&C approach.
268 minusUFM (MkUniqFM fm1) (MkUniqFM fm2) = MkUniqFM $ S.minusUFM fm1 fm2
271 And taking the intersection of two UniqFM's.
274 intersectUFM (MkUniqFM t1) (MkUniqFM t2) = MkUniqFM $ S.intersectUFM t1 t2
275 intersectsUFM (MkUniqFM t1) (MkUniqFM t2) = S.intersectsUFM t1 t2
277 intersectUFM_C f (MkUniqFM fm1) (MkUniqFM fm2)
278 = MkUniqFM $ S.intersectUFM_C f' fm1 fm2
279 where f' (Lazy l) (Lazy r) = Lazy $ f l r
282 Now the usual set of `collection' operators, like map, fold, etc.
285 foldUFM f a (MkUniqFM ufm) = S.foldUFM f' a ufm
286 where f' (Lazy elt) x = f elt x
290 mapUFM fn (MkUniqFM fm) = MkUniqFM (S.mapUFM fn' fm)
291 where fn' (Lazy elt) = Lazy (fn elt)
293 filterUFM fn (MkUniqFM fm) = MkUniqFM (S.filterUFM fn' fm)
294 where fn' (Lazy elt) = fn elt
296 filterUFM_Directly fn (MkUniqFM fm) = MkUniqFM $ S.filterUFM_Directly fn' fm
297 where fn' u (Lazy elt) = fn u elt
300 Note, this takes a long time, O(n), but
301 because we dont want to do this very often, we put up with this.
302 O'rable, but how often do we look at the size of
306 sizeUFM (MkUniqFM fm) = S.sizeUFM fm
308 isNullUFM (MkUniqFM fm) = S.isNullUFM fm
310 -- hashing is used in VarSet.uniqAway, and should be fast
311 -- We use a cheap and cheerful method for now
312 hashUFM (MkUniqFM fm) = S.hashUFM fm
315 looking up in a hurry is the {\em whole point} of this binary tree lark.
316 Lookup up a binary tree is easy (and fast).
319 elemUFM key (MkUniqFM fm) = S.elemUFM key fm
320 elemUFM_Directly key (MkUniqFM fm) = S.elemUFM_Directly key fm
322 lookupUFM (MkUniqFM fm) key = fmap fromLazy $ S.lookupUFM fm key
323 lookupUFM_Directly (MkUniqFM fm) key
324 = fmap fromLazy $ S.lookupUFM_Directly fm key
326 lookupWithDefaultUFM (MkUniqFM fm) deflt key
327 = fromLazy $ S.lookupWithDefaultUFM fm (Lazy deflt) key
329 lookupWithDefaultUFM_Directly (MkUniqFM fm) deflt key
330 = fromLazy $ S.lookupWithDefaultUFM_Directly fm (Lazy deflt) key
333 folds are *wonderful* things.
336 eltsUFM (MkUniqFM fm) = map fromLazy $ S.eltsUFM fm
337 keysUFM (MkUniqFM fm) = S.keysUFM fm
338 ufmToList (MkUniqFM fm) = [ (k, v) | (k, Lazy v) <- S.ufmToList fm ]
339 foldUFM_Directly f elt (MkUniqFM fm)
340 = S.foldUFM_Directly f' elt fm
341 where f' u (Lazy elt') x = f u elt' x