Remove a redundant options pragma
[ghc.git] / compiler / utils / LazyUniqFM.lhs
1 %
2 % (c) The University of Glasgow 2006
3 % (c) The AQUA Project, Glasgow University, 1994-1998
4 %
5
6 LazyUniqFM: Specialised lazy finite maps, for things with @Uniques@
7
8 Based on @UniqFM@.
9
10 Basically, the things need to be in class @Uniquable@, and we use the
11 @getUnique@ method to grab their @Uniques@.
12
13 \begin{code}
14 module LazyUniqFM (
15         -- * Lazy unique-keyed mappings
16         UniqFM,         -- abstract type
17
18         -- ** Manipulating those mappings
19         emptyUFM,
20         unitUFM,
21         unitDirectlyUFM,
22         listToUFM,
23         listToUFM_Directly,
24         addToUFM,addToUFM_C,addToUFM_Acc,
25         addListToUFM,addListToUFM_C,
26         addToUFM_Directly,
27         addListToUFM_Directly,
28         delFromUFM,
29         delFromUFM_Directly,
30         delListFromUFM,
31         plusUFM,
32         plusUFM_C,
33         minusUFM,
34         intersectsUFM,
35         intersectUFM,
36         intersectUFM_C,
37         foldUFM, foldUFM_Directly,
38         mapUFM,
39         elemUFM, elemUFM_Directly,
40         filterUFM, filterUFM_Directly,
41         sizeUFM,
42         hashUFM,
43         isNullUFM,
44         lookupUFM, lookupUFM_Directly,
45         lookupWithDefaultUFM, lookupWithDefaultUFM_Directly,
46         eltsUFM, keysUFM,
47         ufmToList 
48     ) where
49
50 import qualified UniqFM as S
51
52 import Unique
53 import Outputable
54 \end{code}
55
56 %************************************************************************
57 %*                                                                      *
58 \subsection{The @UniqFM@ type, and signatures for the functions}
59 %*                                                                      *
60 %************************************************************************
61
62 We use @FiniteMaps@, with a (@getUnique@-able) @Unique@ as ``key''.
63
64 \begin{code}
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
71 listToUFM_Directly
72                 :: [(Unique, elt)] -> UniqFM elt
73
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
77 addToUFM_Directly
78                 :: UniqFM elt -> Unique -> elt -> UniqFM elt
79
80 addToUFM_C      :: Uniquable key => (elt -> elt -> elt) -- old -> new -> result
81                            -> UniqFM elt                -- old
82                            -> key -> elt                -- new
83                            -> UniqFM elt                -- result
84
85 addToUFM_Acc    :: Uniquable key =>
86                               (elt -> elts -> elts)     -- Add to existing
87                            -> (elt -> elts)             -- New element
88                            -> UniqFM elts               -- old
89                            -> key -> elt                -- new
90                            -> UniqFM elts               -- result
91
92 addListToUFM_C  :: Uniquable key => (elt -> elt -> elt)
93                            -> UniqFM elt -> [(key,elt)]
94                            -> UniqFM elt
95
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
99
100 plusUFM         :: UniqFM elt -> UniqFM elt -> UniqFM elt
101
102 plusUFM_C       :: (elt -> elt -> elt)
103                 -> UniqFM elt -> UniqFM elt -> UniqFM elt
104
105 minusUFM        :: UniqFM elt1 -> UniqFM elt2 -> UniqFM elt1
106
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
111
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
117
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
122
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
126 lookupWithDefaultUFM
127                 :: Uniquable key => UniqFM elt -> elt -> key -> elt
128 lookupWithDefaultUFM_Directly
129                 :: UniqFM elt -> elt -> Unique -> elt
130
131 keysUFM         :: UniqFM elt -> [Unique]       -- Get the keys
132 eltsUFM         :: UniqFM elt -> [elt]
133 ufmToList       :: UniqFM elt -> [(Unique, elt)]
134 \end{code}
135
136 %************************************************************************
137 %*                                                                      *
138 \subsection{The @IdFinMap@ and @TyVarFinMap@ specialisations for Ids/TyVars}
139 %*                                                                      *
140 %************************************************************************
141
142 \begin{code}
143 -- Turn off for now, these need to be updated (SDM 4/98)
144
145 #if 0
146 #ifdef __GLASGOW_HASKELL__
147 -- I don't think HBC was too happy about this (WDP 94/10)
148
149 {-# SPECIALIZE
150     addListToUFM :: UniqFM elt -> [(Name,   elt)] -> UniqFM elt
151   #-}
152 {-# SPECIALIZE
153     addListToUFM_C :: (elt -> elt -> elt) -> UniqFM elt -> [(Name,  elt)] -> UniqFM elt
154   #-}
155 {-# SPECIALIZE
156     addToUFM    :: UniqFM elt -> Unique -> elt  -> UniqFM elt
157   #-}
158 {-# SPECIALIZE
159     listToUFM   :: [(Unique, elt)]     -> UniqFM elt
160   #-}
161 {-# SPECIALIZE
162     lookupUFM   :: UniqFM elt -> Name   -> Maybe elt
163                  , UniqFM elt -> Unique -> Maybe elt
164   #-}
165
166 #endif /* __GLASGOW_HASKELL__ */
167 #endif
168 \end{code}
169
170 %************************************************************************
171 %*                                                                      *
172 \subsubsection{The @UniqFM@ type, and signatures for the functions}
173 %*                                                                      *
174 %************************************************************************
175
176 @UniqFM a@ is a mapping from Unique to a.
177
178 \begin{code}
179 data Lazy a = Lazy { fromLazy :: a }
180
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))
183
184 instance Outputable a => Outputable (UniqFM a) where
185     ppr (MkUniqFM fm) = ppr fm
186
187 instance Outputable a => Outputable (Lazy a) where
188     ppr (Lazy x) = ppr x
189 \end{code}
190
191 %************************************************************************
192 %*                                                                      *
193 \subsubsection{The @UniqFM@ functions}
194 %*                                                                      *
195 %************************************************************************
196
197 First the ways of building a UniqFM.
198
199 \begin{code}
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)
203
204 listToUFM key_elt_pairs
205     = MkUniqFM $ S.listToUFM [ (k, Lazy v) | (k, v) <- key_elt_pairs ]
206 listToUFM_Directly uniq_elt_pairs
207     = MkUniqFM
208     $ S.listToUFM_Directly [ (k, Lazy v) | (k, v) <- uniq_elt_pairs ]
209 \end{code}
210
211 Now ways of adding things to UniqFMs.
212
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.
217
218 \begin{code}
219 addToUFM (MkUniqFM fm) key elt = MkUniqFM $ S.addToUFM fm key (Lazy elt)
220
221 addToUFM_Directly (MkUniqFM fm) u elt
222     = MkUniqFM $ S.addToUFM_Directly fm u (Lazy elt)
223
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)
227
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)
232
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
236     = MkUniqFM
237     $ S.addListToUFM_Directly fm [ (k, Lazy v) | (k, v) <- uniq_elt_pairs ]
238
239 addListToUFM_C combiner (MkUniqFM fm) key_elt_pairs
240  = MkUniqFM
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)
243 \end{code}
244
245 Now ways of removing things from UniqFM.
246
247 \begin{code}
248 delListFromUFM (MkUniqFM fm) lst = MkUniqFM $ S.delListFromUFM fm lst
249
250 delFromUFM          (MkUniqFM fm) key = MkUniqFM $ S.delFromUFM          fm key
251 delFromUFM_Directly (MkUniqFM fm) u   = MkUniqFM $ S.delFromUFM_Directly fm u
252 \end{code}
253
254 Now ways of adding two UniqFM's together.
255
256 \begin{code}
257 plusUFM (MkUniqFM tr1) (MkUniqFM tr2) = MkUniqFM $ S.plusUFM tr1 tr2
258
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
261 \end{code}
262
263 And ways of subtracting them. First the base cases,
264 then the full D&C approach.
265
266 \begin{code}
267 minusUFM (MkUniqFM fm1) (MkUniqFM fm2) = MkUniqFM $ S.minusUFM fm1 fm2
268 \end{code}
269
270 And taking the intersection of two UniqFM's.
271
272 \begin{code}
273 intersectUFM  (MkUniqFM t1) (MkUniqFM t2) = MkUniqFM $ S.intersectUFM t1 t2
274 intersectsUFM (MkUniqFM t1) (MkUniqFM t2) = S.intersectsUFM t1 t2
275
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
279 \end{code}
280
281 Now the usual set of `collection' operators, like map, fold, etc.
282
283 \begin{code}
284 foldUFM f a (MkUniqFM ufm) = S.foldUFM f' a ufm
285     where f' (Lazy elt) x = f elt x
286 \end{code}
287
288 \begin{code}
289 mapUFM fn (MkUniqFM fm) = MkUniqFM (S.mapUFM fn' fm)
290     where fn' (Lazy elt) = Lazy (fn elt)
291
292 filterUFM fn (MkUniqFM fm) = MkUniqFM (S.filterUFM fn' fm)
293     where fn' (Lazy elt) = fn elt
294
295 filterUFM_Directly fn (MkUniqFM fm) = MkUniqFM $ S.filterUFM_Directly fn' fm
296     where fn' u (Lazy elt) = fn u elt
297 \end{code}
298
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
302 a finite map?
303
304 \begin{code}
305 sizeUFM (MkUniqFM fm) = S.sizeUFM fm
306
307 isNullUFM (MkUniqFM fm) = S.isNullUFM fm
308
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
312 \end{code}
313
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).
316
317 \begin{code}
318 elemUFM          key (MkUniqFM fm) = S.elemUFM          key fm
319 elemUFM_Directly key (MkUniqFM fm) = S.elemUFM_Directly key fm
320
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
324
325 lookupWithDefaultUFM (MkUniqFM fm) deflt key
326     = fromLazy $ S.lookupWithDefaultUFM fm (Lazy deflt) key
327
328 lookupWithDefaultUFM_Directly (MkUniqFM fm) deflt key
329  = fromLazy $ S.lookupWithDefaultUFM_Directly fm (Lazy deflt) key
330 \end{code}
331
332 folds are *wonderful* things.
333
334 \begin{code}
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
341 \end{code}
342