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
17 -- XXX Not actually abstract because of nativeGen/MachRegs; sigh
18 Lazy(Lazy), -- XXX Also for nativeGen/MachRegs; sigh
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 newtype UniqFM ele = MkUniqFM (S.UniqFM (Lazy ele))
184 instance Outputable (S.UniqFM (Lazy 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