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 {-# OPTIONS -Wall -fno-warn-name-shadowing -Werror #-}
  15 module LazyUniqFM (
  16         -- * Lazy unique-keyed mappings
  17         UniqFM,         -- abstract type
  18
  19         -- ** Manipulating those mappings
  20         emptyUFM,
  21         unitUFM,
  22         unitDirectlyUFM,
  23         listToUFM,
  24         listToUFM_Directly,
  25         addToUFM,addToUFM_C,addToUFM_Acc,
  26         addListToUFM,addListToUFM_C,
  27         addToUFM_Directly,
  28         addListToUFM_Directly,
  29         delFromUFM,
  30         delFromUFM_Directly,
  31         delListFromUFM,
  32         plusUFM,
  33         plusUFM_C,
  34         minusUFM,
  35         intersectsUFM,
  36         intersectUFM,
  37         intersectUFM_C,
  38         foldUFM, foldUFM_Directly,
  39         mapUFM,
  40         elemUFM, elemUFM_Directly,
  41         filterUFM, filterUFM_Directly,
  42         sizeUFM,
  43         hashUFM,
  44         isNullUFM,
  45         lookupUFM, lookupUFM_Directly,
  46         lookupWithDefaultUFM, lookupWithDefaultUFM_Directly,
  47         eltsUFM, keysUFM,
  48         ufmToList
  49     ) where
  50
  51 import qualified UniqFM as S
  52
  53 import Unique
  54 import Outputable
  55 \end{code}
  56
  57 %************************************************************************
  58 %*                                                                      *
  59 \subsection{The @UniqFM@ type, and signatures for the functions}
  60 %*                                                                      *
  61 %************************************************************************
  62
  63 We use @FiniteMaps@, with a (@getUnique@-able) @Unique@ as ``key''.
  64
  65 \begin{code}
  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
  72 listToUFM_Directly
  73                 :: [(Unique, elt)] -> UniqFM elt
  74
  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
  78 addToUFM_Directly
  79                 :: UniqFM elt -> Unique -> elt -> UniqFM elt
  80
  81 addToUFM_C      :: Uniquable key => (elt -> elt -> elt) -- old -> new -> result
  82                            -> UniqFM elt                -- old
  83                            -> key -> elt                -- new
  84                            -> UniqFM elt                -- result
  85
  86 addToUFM_Acc    :: Uniquable key =>
  87                               (elt -> elts -> elts)     -- Add to existing
  88                            -> (elt -> elts)             -- New element
  89                            -> UniqFM elts               -- old
  90                            -> key -> elt                -- new
  91                            -> UniqFM elts               -- result
  92
  93 addListToUFM_C  :: Uniquable key => (elt -> elt -> elt)
  94                            -> UniqFM elt -> [(key,elt)]
  95                            -> UniqFM elt
  96
  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
 100
 101 plusUFM         :: UniqFM elt -> UniqFM elt -> UniqFM elt
 102
 103 plusUFM_C       :: (elt -> elt -> elt)
 104                 -> UniqFM elt -> UniqFM elt -> UniqFM elt
 105
 106 minusUFM        :: UniqFM elt1 -> UniqFM elt2 -> UniqFM elt1
 107
 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
 112
 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
 118
 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
 123
 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
 127 lookupWithDefaultUFM
 128                 :: Uniquable key => UniqFM elt -> elt -> key -> elt
 129 lookupWithDefaultUFM_Directly
 130                 :: UniqFM elt -> elt -> Unique -> elt
 131
 132 keysUFM         :: UniqFM elt -> [Unique]       -- Get the keys
 133 eltsUFM         :: UniqFM elt -> [elt]
 134 ufmToList       :: UniqFM elt -> [(Unique, elt)]
 135 \end{code}
 136
 137 %************************************************************************
 138 %*                                                                      *
 139 \subsection{The @IdFinMap@ and @TyVarFinMap@ specialisations for Ids/TyVars}
 140 %*                                                                      *
 141 %************************************************************************
 142
 143 \begin{code}
 144 -- Turn off for now, these need to be updated (SDM 4/98)
 145
 146 #if 0
 147 #ifdef __GLASGOW_HASKELL__
 148 -- I don't think HBC was too happy about this (WDP 94/10)
 149
 150 {-# SPECIALIZE
 151     addListToUFM :: UniqFM elt -> [(Name,   elt)] -> UniqFM elt
 152   #-}
 153 {-# SPECIALIZE
 154     addListToUFM_C :: (elt -> elt -> elt) -> UniqFM elt -> [(Name,  elt)] -> UniqFM elt
 155   #-}
 156 {-# SPECIALIZE
 157     addToUFM    :: UniqFM elt -> Unique -> elt  -> UniqFM elt
 158   #-}
 159 {-# SPECIALIZE
 160     listToUFM   :: [(Unique, elt)]     -> UniqFM elt
 161   #-}
 162 {-# SPECIALIZE
 163     lookupUFM   :: UniqFM elt -> Name   -> Maybe elt
 164                  , UniqFM elt -> Unique -> Maybe elt
 165   #-}
 166
 167 #endif /* __GLASGOW_HASKELL__ */
 168 #endif
 169 \end{code}
 170
 171 %************************************************************************
 172 %*                                                                      *
 173 \subsubsection{The @UniqFM@ type, and signatures for the functions}
 174 %*                                                                      *
 175 %************************************************************************
 176
 177 @UniqFM a@ is a mapping from Unique to a.
 178
 179 \begin{code}
 180 data Lazy a = Lazy { fromLazy :: a }
 181
 182 -- | @UniqFM a@ is a mapping from Unique to @a@ where the element @a@ is evaluated lazily.
 183 newtype UniqFM ele = MkUniqFM (S.UniqFM (Lazy ele))
 184
 185 instance Outputable a => Outputable (UniqFM a) where
 186     ppr (MkUniqFM fm) = ppr fm
 187
 188 instance Outputable a => Outputable (Lazy a) where
 189     ppr (Lazy x) = ppr x
 190 \end{code}
 191
 192 %************************************************************************
 193 %*                                                                      *
 194 \subsubsection{The @UniqFM@ functions}
 195 %*                                                                      *
 196 %************************************************************************
 197
 198 First the ways of building a UniqFM.
 199
 200 \begin{code}
 201 emptyUFM                     = MkUniqFM $ S.EmptyUFM
 202 unitUFM      key elt = MkUniqFM $ S.unitUFM key (Lazy elt)
 203 unitDirectlyUFM key elt = MkUniqFM $ S.unitDirectlyUFM key (Lazy elt)
 204
 205 listToUFM key_elt_pairs
 206     = MkUniqFM $ S.listToUFM [ (k, Lazy v) | (k, v) <- key_elt_pairs ]
 207 listToUFM_Directly uniq_elt_pairs
 208     = MkUniqFM
 209     $ S.listToUFM_Directly [ (k, Lazy v) | (k, v) <- uniq_elt_pairs ]
 210 \end{code}
 211
 212 Now ways of adding things to UniqFMs.
 213
 214 There is an alternative version of @addListToUFM_C@, that uses @plusUFM@,
 215 but the semantics of this operation demands a linear insertion;
 216 perhaps the version without the combinator function
 217 could be optimised using it.
 218
 219 \begin{code}
 220 addToUFM (MkUniqFM fm) key elt = MkUniqFM $ S.addToUFM fm key (Lazy elt)
 221
 222 addToUFM_Directly (MkUniqFM fm) u elt
 223     = MkUniqFM $ S.addToUFM_Directly fm u (Lazy elt)
 224
 225 addToUFM_C combiner (MkUniqFM fm) key elt
 226   = MkUniqFM $ S.addToUFM_C combiner' fm key (Lazy elt)
 227     where combiner' (Lazy l) (Lazy r) = Lazy (combiner l r)
 228
 229 addToUFM_Acc add unit (MkUniqFM fm) key item
 230     = MkUniqFM $ S.addToUFM_Acc add' unit' fm key item
 231     where add' elt (Lazy elts) = Lazy (add elt elts)
 232           unit' elt = Lazy (unit elt)
 233
 234 addListToUFM (MkUniqFM fm) key_elt_pairs
 235     = MkUniqFM $ S.addListToUFM fm [ (k, Lazy v) | (k, v) <- key_elt_pairs ]
 236 addListToUFM_Directly (MkUniqFM fm) uniq_elt_pairs
 237     = MkUniqFM
 238     $ S.addListToUFM_Directly fm [ (k, Lazy v) | (k, v) <- uniq_elt_pairs ]
 239
 240 addListToUFM_C combiner (MkUniqFM fm) key_elt_pairs
 241  = MkUniqFM
 242  $ S.addListToUFM_C combiner' fm [ (k, Lazy v) | (k, v) <- key_elt_pairs ]
 243     where combiner' (Lazy l) (Lazy r) = Lazy (combiner l r)
 244 \end{code}
 245
 246 Now ways of removing things from UniqFM.
 247
 248 \begin{code}
 249 delListFromUFM (MkUniqFM fm) lst = MkUniqFM $ S.delListFromUFM fm lst
 250
 251 delFromUFM          (MkUniqFM fm) key = MkUniqFM $ S.delFromUFM          fm key
 252 delFromUFM_Directly (MkUniqFM fm) u   = MkUniqFM $ S.delFromUFM_Directly fm u
 253 \end{code}
 254
 255 Now ways of adding two UniqFM's together.
 256
 257 \begin{code}
 258 plusUFM (MkUniqFM tr1) (MkUniqFM tr2) = MkUniqFM $ S.plusUFM tr1 tr2
 259
 260 plusUFM_C f (MkUniqFM tr1) (MkUniqFM tr2) = MkUniqFM $ S.plusUFM_C f' tr1 tr2
 261     where f' (Lazy l) (Lazy r) = Lazy $ f l r
 262 \end{code}
 263
 264 And ways of subtracting them. First the base cases,
 265 then the full D&C approach.
 266
 267 \begin{code}
 268 minusUFM (MkUniqFM fm1) (MkUniqFM fm2) = MkUniqFM $ S.minusUFM fm1 fm2
 269 \end{code}
 270
 271 And taking the intersection of two UniqFM's.
 272
 273 \begin{code}
 274 intersectUFM  (MkUniqFM t1) (MkUniqFM t2) = MkUniqFM $ S.intersectUFM t1 t2
 275 intersectsUFM (MkUniqFM t1) (MkUniqFM t2) = S.intersectsUFM t1 t2
 276
 277 intersectUFM_C f (MkUniqFM fm1) (MkUniqFM fm2)
 278     = MkUniqFM $ S.intersectUFM_C f' fm1 fm2
 279     where f' (Lazy l) (Lazy r) = Lazy $ f l r
 280 \end{code}
 281
 282 Now the usual set of `collection' operators, like map, fold, etc.
 283
 284 \begin{code}
 285 foldUFM f a (MkUniqFM ufm) = S.foldUFM f' a ufm
 286     where f' (Lazy elt) x = f elt x
 287 \end{code}
 288
 289 \begin{code}
 290 mapUFM fn (MkUniqFM fm) = MkUniqFM (S.mapUFM fn' fm)
 291     where fn' (Lazy elt) = Lazy (fn elt)
 292
 293 filterUFM fn (MkUniqFM fm) = MkUniqFM (S.filterUFM fn' fm)
 294     where fn' (Lazy elt) = fn elt
 295
 296 filterUFM_Directly fn (MkUniqFM fm) = MkUniqFM $ S.filterUFM_Directly fn' fm
 297     where fn' u (Lazy elt) = fn u elt
 298 \end{code}
 299
 300 Note, this takes a long time, O(n), but
 301 because we dont want to do this very often, we put up with this.
 302 O'rable, but how often do we look at the size of
 303 a finite map?
 304
 305 \begin{code}
 306 sizeUFM (MkUniqFM fm) = S.sizeUFM fm
 307
 308 isNullUFM (MkUniqFM fm) = S.isNullUFM fm
 309
 310 -- hashing is used in VarSet.uniqAway, and should be fast
 311 -- We use a cheap and cheerful method for now
 312 hashUFM (MkUniqFM fm) = S.hashUFM fm
 313 \end{code}
 314
 315 looking up in a hurry is the {\em whole point} of this binary tree lark.
 316 Lookup up a binary tree is easy (and fast).
 317
 318 \begin{code}
 319 elemUFM          key (MkUniqFM fm) = S.elemUFM          key fm
 320 elemUFM_Directly key (MkUniqFM fm) = S.elemUFM_Directly key fm
 321
 322 lookupUFM (MkUniqFM fm) key = fmap fromLazy $ S.lookupUFM fm key
 323 lookupUFM_Directly (MkUniqFM fm) key
 324     = fmap fromLazy $ S.lookupUFM_Directly fm key
 325
 326 lookupWithDefaultUFM (MkUniqFM fm) deflt key
 327     = fromLazy $ S.lookupWithDefaultUFM fm (Lazy deflt) key
 328
 329 lookupWithDefaultUFM_Directly (MkUniqFM fm) deflt key
 330  = fromLazy $ S.lookupWithDefaultUFM_Directly fm (Lazy deflt) key
 331 \end{code}
 332
 333 folds are *wonderful* things.
 334
 335 \begin{code}
 336 eltsUFM   (MkUniqFM fm) = map fromLazy $ S.eltsUFM fm
 337 keysUFM   (MkUniqFM fm) = S.keysUFM fm
 338 ufmToList (MkUniqFM fm) = [ (k, v) | (k, Lazy v) <- S.ufmToList fm ]
 339 foldUFM_Directly f elt (MkUniqFM fm)
 340     = S.foldUFM_Directly f' elt fm
 341     where f' u (Lazy elt') x = f u elt' x
 342 \end{code}
 343