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 #-}
15 {-# LANGUAGE UndecidableInstances #-}
17 UniqFM, -- abstract type
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 newtype UniqFM ele = MkUniqFM (S.UniqFM (Lazy ele))
183 instance Outputable (S.UniqFM (Lazy a)) => Outputable (UniqFM a) where
184 ppr (MkUniqFM fm) = ppr fm
186 instance Outputable a => Outputable (Lazy a) where
190 %************************************************************************
192 \subsubsection{The @UniqFM@ functions}
194 %************************************************************************
196 First the ways of building a UniqFM.
199 emptyUFM = MkUniqFM $ S.EmptyUFM
200 unitUFM key elt = MkUniqFM $ S.unitUFM key (Lazy elt)
201 unitDirectlyUFM key elt = MkUniqFM $ S.unitDirectlyUFM key (Lazy elt)
203 listToUFM key_elt_pairs
204 = MkUniqFM $ S.listToUFM [ (k, Lazy v) | (k, v) <- key_elt_pairs ]
205 listToUFM_Directly uniq_elt_pairs
207 $ S.listToUFM_Directly [ (k, Lazy v) | (k, v) <- uniq_elt_pairs ]
210 Now ways of adding things to UniqFMs.
212 There is an alternative version of @addListToUFM_C@, that uses @plusUFM@,
213 but the semantics of this operation demands a linear insertion;
214 perhaps the version without the combinator function
215 could be optimised using it.
218 addToUFM (MkUniqFM fm) key elt = MkUniqFM $ S.addToUFM fm key (Lazy elt)
220 addToUFM_Directly (MkUniqFM fm) u elt
221 = MkUniqFM $ S.addToUFM_Directly fm u (Lazy elt)
223 addToUFM_C combiner (MkUniqFM fm) key elt
224 = MkUniqFM $ S.addToUFM_C combiner' fm key (Lazy elt)
225 where combiner' (Lazy l) (Lazy r) = Lazy (combiner l r)
227 addToUFM_Acc add unit (MkUniqFM fm) key item
228 = MkUniqFM $ S.addToUFM_Acc add' unit' fm key item
229 where add' elt (Lazy elts) = Lazy (add elt elts)
230 unit' elt = Lazy (unit elt)
232 addListToUFM (MkUniqFM fm) key_elt_pairs
233 = MkUniqFM $ S.addListToUFM fm [ (k, Lazy v) | (k, v) <- key_elt_pairs ]
234 addListToUFM_Directly (MkUniqFM fm) uniq_elt_pairs
236 $ S.addListToUFM_Directly fm [ (k, Lazy v) | (k, v) <- uniq_elt_pairs ]
238 addListToUFM_C combiner (MkUniqFM fm) key_elt_pairs
240 $ S.addListToUFM_C combiner' fm [ (k, Lazy v) | (k, v) <- key_elt_pairs ]
241 where combiner' (Lazy l) (Lazy r) = Lazy (combiner l r)
244 Now ways of removing things from UniqFM.
247 delListFromUFM (MkUniqFM fm) lst = MkUniqFM $ S.delListFromUFM fm lst
249 delFromUFM (MkUniqFM fm) key = MkUniqFM $ S.delFromUFM fm key
250 delFromUFM_Directly (MkUniqFM fm) u = MkUniqFM $ S.delFromUFM_Directly fm u
253 Now ways of adding two UniqFM's together.
256 plusUFM (MkUniqFM tr1) (MkUniqFM tr2) = MkUniqFM $ S.plusUFM tr1 tr2
258 plusUFM_C f (MkUniqFM tr1) (MkUniqFM tr2) = MkUniqFM $ S.plusUFM_C f' tr1 tr2
259 where f' (Lazy l) (Lazy r) = Lazy $ f l r
262 And ways of subtracting them. First the base cases,
263 then the full D&C approach.
266 minusUFM (MkUniqFM fm1) (MkUniqFM fm2) = MkUniqFM $ S.minusUFM fm1 fm2
269 And taking the intersection of two UniqFM's.
272 intersectUFM (MkUniqFM t1) (MkUniqFM t2) = MkUniqFM $ S.intersectUFM t1 t2
273 intersectsUFM (MkUniqFM t1) (MkUniqFM t2) = S.intersectsUFM t1 t2
275 intersectUFM_C f (MkUniqFM fm1) (MkUniqFM fm2)
276 = MkUniqFM $ S.intersectUFM_C f' fm1 fm2
277 where f' (Lazy l) (Lazy r) = Lazy $ f l r
280 Now the usual set of `collection' operators, like map, fold, etc.
283 foldUFM f a (MkUniqFM ufm) = S.foldUFM f' a ufm
284 where f' (Lazy elt) x = f elt x
288 mapUFM fn (MkUniqFM fm) = MkUniqFM (S.mapUFM fn' fm)
289 where fn' (Lazy elt) = Lazy (fn elt)
291 filterUFM fn (MkUniqFM fm) = MkUniqFM (S.filterUFM fn' fm)
292 where fn' (Lazy elt) = fn elt
294 filterUFM_Directly fn (MkUniqFM fm) = MkUniqFM $ S.filterUFM_Directly fn' fm
295 where fn' u (Lazy elt) = fn u elt
298 Note, this takes a long time, O(n), but
299 because we dont want to do this very often, we put up with this.
300 O'rable, but how often do we look at the size of
304 sizeUFM (MkUniqFM fm) = S.sizeUFM fm
306 isNullUFM (MkUniqFM fm) = S.isNullUFM fm
308 -- hashing is used in VarSet.uniqAway, and should be fast
309 -- We use a cheap and cheerful method for now
310 hashUFM (MkUniqFM fm) = S.hashUFM fm
313 looking up in a hurry is the {\em whole point} of this binary tree lark.
314 Lookup up a binary tree is easy (and fast).
317 elemUFM key (MkUniqFM fm) = S.elemUFM key fm
318 elemUFM_Directly key (MkUniqFM fm) = S.elemUFM_Directly key fm
320 lookupUFM (MkUniqFM fm) key = fmap fromLazy $ S.lookupUFM fm key
321 lookupUFM_Directly (MkUniqFM fm) key
322 = fmap fromLazy $ S.lookupUFM_Directly fm key
324 lookupWithDefaultUFM (MkUniqFM fm) deflt key
325 = fromLazy $ S.lookupWithDefaultUFM fm (Lazy deflt) key
327 lookupWithDefaultUFM_Directly (MkUniqFM fm) deflt key
328 = fromLazy $ S.lookupWithDefaultUFM_Directly fm (Lazy deflt) key
331 folds are *wonderful* things.
334 eltsUFM (MkUniqFM fm) = map fromLazy $ S.eltsUFM fm
335 keysUFM (MkUniqFM fm) = S.keysUFM fm
336 ufmToList (MkUniqFM fm) = [ (k, v) | (k, Lazy v) <- S.ufmToList fm ]
337 foldUFM_Directly f elt (MkUniqFM fm)
338 = S.foldUFM_Directly f' elt fm
339 where f' u (Lazy elt') x = f u elt' x