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 -fallow-undecidable-instances #-}
  15 module LazyUniqFM (
  16         UniqFM(..),     -- abstract type
  17     -- XXX Not actually abstract because of nativeGen/MachRegs; sigh
  18     Lazy(Lazy), -- XXX Also for nativeGen/MachRegs; sigh
  19
  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 newtype UniqFM ele = MkUniqFM (S.UniqFM (Lazy ele))
 183
 184 instance Outputable (S.UniqFM (Lazy 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