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