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 -fallow-undecidable-instances #-}
16 UniqFM, -- abstract type
23 addToUFM,addToUFM_C,addToUFM_Acc,
24 addListToUFM,addListToUFM_C,
26 addListToUFM_Directly,
36 foldUFM, foldUFM_Directly,
38 elemUFM, elemUFM_Directly,
39 filterUFM, filterUFM_Directly,
43 lookupUFM, lookupUFM_Directly,
44 lookupWithDefaultUFM, lookupWithDefaultUFM_Directly,
49 import qualified UniqFM as S
55 %************************************************************************
57 \subsection{The @UniqFM@ type, and signatures for the functions}
59 %************************************************************************
61 We use @FiniteMaps@, with a (@getUnique@-able) @Unique@ as ``key''.
64 emptyUFM :: UniqFM elt
65 isNullUFM :: UniqFM elt -> Bool
66 unitUFM :: Uniquable key => key -> elt -> UniqFM elt
67 unitDirectlyUFM -- got the Unique already
68 :: Unique -> elt -> UniqFM elt
69 listToUFM :: Uniquable key => [(key,elt)] -> UniqFM elt
71 :: [(Unique, elt)] -> UniqFM elt
73 addToUFM :: Uniquable key => UniqFM elt -> key -> elt -> UniqFM elt
74 addListToUFM :: Uniquable key => UniqFM elt -> [(key,elt)] -> UniqFM elt
75 addListToUFM_Directly :: UniqFM elt -> [(Unique,elt)] -> UniqFM elt
77 :: UniqFM elt -> Unique -> elt -> UniqFM elt
79 addToUFM_C :: Uniquable key => (elt -> elt -> elt) -- old -> new -> result
82 -> UniqFM elt -- result
84 addToUFM_Acc :: Uniquable key =>
85 (elt -> elts -> elts) -- Add to existing
86 -> (elt -> elts) -- New element
89 -> UniqFM elts -- result
91 addListToUFM_C :: Uniquable key => (elt -> elt -> elt)
92 -> UniqFM elt -> [(key,elt)]
95 delFromUFM :: Uniquable key => UniqFM elt -> key -> UniqFM elt
96 delListFromUFM :: Uniquable key => UniqFM elt -> [key] -> UniqFM elt
97 delFromUFM_Directly :: UniqFM elt -> Unique -> UniqFM elt
99 plusUFM :: UniqFM elt -> UniqFM elt -> UniqFM elt
101 plusUFM_C :: (elt -> elt -> elt)
102 -> UniqFM elt -> UniqFM elt -> UniqFM elt
104 minusUFM :: UniqFM elt1 -> UniqFM elt2 -> UniqFM elt1
106 intersectUFM :: UniqFM elt -> UniqFM elt -> UniqFM elt
107 intersectUFM_C :: (elt1 -> elt2 -> elt3)
108 -> UniqFM elt1 -> UniqFM elt2 -> UniqFM elt3
109 intersectsUFM :: UniqFM elt1 -> UniqFM elt2 -> Bool
111 foldUFM :: (elt -> a -> a) -> a -> UniqFM elt -> a
112 foldUFM_Directly:: (Unique -> elt -> a -> a) -> a -> UniqFM elt -> a
113 mapUFM :: (elt1 -> elt2) -> UniqFM elt1 -> UniqFM elt2
114 filterUFM :: (elt -> Bool) -> UniqFM elt -> UniqFM elt
115 filterUFM_Directly :: (Unique -> elt -> Bool) -> UniqFM elt -> UniqFM elt
117 sizeUFM :: UniqFM elt -> Int
118 hashUFM :: UniqFM elt -> Int
119 elemUFM :: Uniquable key => key -> UniqFM elt -> Bool
120 elemUFM_Directly:: Unique -> UniqFM elt -> Bool
122 lookupUFM :: Uniquable key => UniqFM elt -> key -> Maybe elt
123 lookupUFM_Directly -- when you've got the Unique already
124 :: UniqFM elt -> Unique -> Maybe elt
126 :: Uniquable key => UniqFM elt -> elt -> key -> elt
127 lookupWithDefaultUFM_Directly
128 :: UniqFM elt -> elt -> Unique -> elt
130 keysUFM :: UniqFM elt -> [Unique] -- Get the keys
131 eltsUFM :: UniqFM elt -> [elt]
132 ufmToList :: UniqFM elt -> [(Unique, elt)]
135 %************************************************************************
137 \subsection{The @IdFinMap@ and @TyVarFinMap@ specialisations for Ids/TyVars}
139 %************************************************************************
142 -- Turn off for now, these need to be updated (SDM 4/98)
145 #ifdef __GLASGOW_HASKELL__
146 -- I don't think HBC was too happy about this (WDP 94/10)
149 addListToUFM :: UniqFM elt -> [(Name, elt)] -> UniqFM elt
152 addListToUFM_C :: (elt -> elt -> elt) -> UniqFM elt -> [(Name, elt)] -> UniqFM elt
155 addToUFM :: UniqFM elt -> Unique -> elt -> UniqFM elt
158 listToUFM :: [(Unique, elt)] -> UniqFM elt
161 lookupUFM :: UniqFM elt -> Name -> Maybe elt
162 , UniqFM elt -> Unique -> Maybe elt
165 #endif /* __GLASGOW_HASKELL__ */
169 %************************************************************************
171 \subsubsection{The @UniqFM@ type, and signatures for the functions}
173 %************************************************************************
175 @UniqFM a@ is a mapping from Unique to a.
178 data Lazy a = Lazy { fromLazy :: a }
180 newtype UniqFM ele = MkUniqFM (S.UniqFM (Lazy ele))
182 instance Outputable (S.UniqFM (Lazy a)) => Outputable (UniqFM a) where
183 ppr (MkUniqFM fm) = ppr fm
185 instance Outputable a => Outputable (Lazy a) where
189 %************************************************************************
191 \subsubsection{The @UniqFM@ functions}
193 %************************************************************************
195 First the ways of building a UniqFM.
198 emptyUFM = MkUniqFM $ S.EmptyUFM
199 unitUFM key elt = MkUniqFM $ S.unitUFM key (Lazy elt)
200 unitDirectlyUFM key elt = MkUniqFM $ S.unitDirectlyUFM key (Lazy elt)
202 listToUFM key_elt_pairs
203 = MkUniqFM $ S.listToUFM [ (k, Lazy v) | (k, v) <- key_elt_pairs ]
204 listToUFM_Directly uniq_elt_pairs
206 $ S.listToUFM_Directly [ (k, Lazy v) | (k, v) <- uniq_elt_pairs ]
209 Now ways of adding things to UniqFMs.
211 There is an alternative version of @addListToUFM_C@, that uses @plusUFM@,
212 but the semantics of this operation demands a linear insertion;
213 perhaps the version without the combinator function
214 could be optimised using it.
217 addToUFM (MkUniqFM fm) key elt = MkUniqFM $ S.addToUFM fm key (Lazy elt)
219 addToUFM_Directly (MkUniqFM fm) u elt
220 = MkUniqFM $ S.addToUFM_Directly fm u (Lazy elt)
222 addToUFM_C combiner (MkUniqFM fm) key elt
223 = MkUniqFM $ S.addToUFM_C combiner' fm key (Lazy elt)
224 where combiner' (Lazy l) (Lazy r) = Lazy (combiner l r)
226 addToUFM_Acc add unit (MkUniqFM fm) key item
227 = MkUniqFM $ S.addToUFM_Acc add' unit' fm key item
228 where add' elt (Lazy elts) = Lazy (add elt elts)
229 unit' elt = Lazy (unit elt)
231 addListToUFM (MkUniqFM fm) key_elt_pairs
232 = MkUniqFM $ S.addListToUFM fm [ (k, Lazy v) | (k, v) <- key_elt_pairs ]
233 addListToUFM_Directly (MkUniqFM fm) uniq_elt_pairs
235 $ S.addListToUFM_Directly fm [ (k, Lazy v) | (k, v) <- uniq_elt_pairs ]
237 addListToUFM_C combiner (MkUniqFM fm) key_elt_pairs
239 $ S.addListToUFM_C combiner' fm [ (k, Lazy v) | (k, v) <- key_elt_pairs ]
240 where combiner' (Lazy l) (Lazy r) = Lazy (combiner l r)
243 Now ways of removing things from UniqFM.
246 delListFromUFM (MkUniqFM fm) lst = MkUniqFM $ S.delListFromUFM fm lst
248 delFromUFM (MkUniqFM fm) key = MkUniqFM $ S.delFromUFM fm key
249 delFromUFM_Directly (MkUniqFM fm) u = MkUniqFM $ S.delFromUFM_Directly fm u
252 Now ways of adding two UniqFM's together.
255 plusUFM (MkUniqFM tr1) (MkUniqFM tr2) = MkUniqFM $ S.plusUFM tr1 tr2
257 plusUFM_C f (MkUniqFM tr1) (MkUniqFM tr2) = MkUniqFM $ S.plusUFM_C f' tr1 tr2
258 where f' (Lazy l) (Lazy r) = Lazy $ f l r
261 And ways of subtracting them. First the base cases,
262 then the full D&C approach.
265 minusUFM (MkUniqFM fm1) (MkUniqFM fm2) = MkUniqFM $ S.minusUFM fm1 fm2
268 And taking the intersection of two UniqFM's.
271 intersectUFM (MkUniqFM t1) (MkUniqFM t2) = MkUniqFM $ S.intersectUFM t1 t2
272 intersectsUFM (MkUniqFM t1) (MkUniqFM t2) = S.intersectsUFM t1 t2
274 intersectUFM_C f (MkUniqFM fm1) (MkUniqFM fm2)
275 = MkUniqFM $ S.intersectUFM_C f' fm1 fm2
276 where f' (Lazy l) (Lazy r) = Lazy $ f l r
279 Now the usual set of `collection' operators, like map, fold, etc.
282 foldUFM f a (MkUniqFM ufm) = S.foldUFM f' a ufm
283 where f' (Lazy elt) x = f elt x
287 mapUFM fn (MkUniqFM fm) = MkUniqFM (S.mapUFM fn' fm)
288 where fn' (Lazy elt) = Lazy (fn elt)
290 filterUFM fn (MkUniqFM fm) = MkUniqFM (S.filterUFM fn' fm)
291 where fn' (Lazy elt) = fn elt
293 filterUFM_Directly fn (MkUniqFM fm) = MkUniqFM $ S.filterUFM_Directly fn' fm
294 where fn' u (Lazy elt) = fn u elt
297 Note, this takes a long time, O(n), but
298 because we dont want to do this very often, we put up with this.
299 O'rable, but how often do we look at the size of
303 sizeUFM (MkUniqFM fm) = S.sizeUFM fm
305 isNullUFM (MkUniqFM fm) = S.isNullUFM fm
307 -- hashing is used in VarSet.uniqAway, and should be fast
308 -- We use a cheap and cheerful method for now
309 hashUFM (MkUniqFM fm) = S.hashUFM fm
312 looking up in a hurry is the {\em whole point} of this binary tree lark.
313 Lookup up a binary tree is easy (and fast).
316 elemUFM key (MkUniqFM fm) = S.elemUFM key fm
317 elemUFM_Directly key (MkUniqFM fm) = S.elemUFM_Directly key fm
319 lookupUFM (MkUniqFM fm) key = fmap fromLazy $ S.lookupUFM fm key
320 lookupUFM_Directly (MkUniqFM fm) key
321 = fmap fromLazy $ S.lookupUFM_Directly fm key
323 lookupWithDefaultUFM (MkUniqFM fm) deflt key
324 = fromLazy $ S.lookupWithDefaultUFM fm (Lazy deflt) key
326 lookupWithDefaultUFM_Directly (MkUniqFM fm) deflt key
327 = fromLazy $ S.lookupWithDefaultUFM_Directly fm (Lazy deflt) key
330 folds are *wonderful* things.
333 eltsUFM (MkUniqFM fm) = map fromLazy $ S.eltsUFM fm
334 keysUFM (MkUniqFM fm) = S.keysUFM fm
335 ufmToList (MkUniqFM fm) = [ (k, v) | (k, Lazy v) <- S.ufmToList fm ]
336 foldUFM_Directly f elt (MkUniqFM fm)
337 = S.foldUFM_Directly f' elt fm
338 where f' u (Lazy elt') x = f u elt' x