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 {-# LANGUAGE UndecidableInstances #-}
  16 module LazyUniqFM (
  17         UniqFM,         -- abstract type
  18
  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 newtype UniqFM ele = MkUniqFM (S.UniqFM (Lazy ele))
 182
 183 instance Outputable (S.UniqFM (Lazy a)) => Outputable (UniqFM a) where
 184     ppr (MkUniqFM fm) = ppr fm
 185
 186 instance Outputable a => Outputable (Lazy a) where
 187     ppr (Lazy x) = ppr x
 188 \end{code}
 189
 190 %************************************************************************
 191 %*                                                                      *
 192 \subsubsection{The @UniqFM@ functions}
 193 %*                                                                      *
 194 %************************************************************************
 195
 196 First the ways of building a UniqFM.
 197
 198 \begin{code}
 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)
 202
 203 listToUFM key_elt_pairs
 204     = MkUniqFM $ S.listToUFM [ (k, Lazy v) | (k, v) <- key_elt_pairs ]
 205 listToUFM_Directly uniq_elt_pairs
 206     = MkUniqFM
 207     $ S.listToUFM_Directly [ (k, Lazy v) | (k, v) <- uniq_elt_pairs ]
 208 \end{code}
 209
 210 Now ways of adding things to UniqFMs.
 211
 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.
 216
 217 \begin{code}
 218 addToUFM (MkUniqFM fm) key elt = MkUniqFM $ S.addToUFM fm key (Lazy elt)
 219
 220 addToUFM_Directly (MkUniqFM fm) u elt
 221     = MkUniqFM $ S.addToUFM_Directly fm u (Lazy elt)
 222
 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)
 226
 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)
 231
 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
 235     = MkUniqFM
 236     $ S.addListToUFM_Directly fm [ (k, Lazy v) | (k, v) <- uniq_elt_pairs ]
 237
 238 addListToUFM_C combiner (MkUniqFM fm) key_elt_pairs
 239  = MkUniqFM
 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)
 242 \end{code}
 243
 244 Now ways of removing things from UniqFM.
 245
 246 \begin{code}
 247 delListFromUFM (MkUniqFM fm) lst = MkUniqFM $ S.delListFromUFM fm lst
 248
 249 delFromUFM          (MkUniqFM fm) key = MkUniqFM $ S.delFromUFM          fm key
 250 delFromUFM_Directly (MkUniqFM fm) u   = MkUniqFM $ S.delFromUFM_Directly fm u
 251 \end{code}
 252
 253 Now ways of adding two UniqFM's together.
 254
 255 \begin{code}
 256 plusUFM (MkUniqFM tr1) (MkUniqFM tr2) = MkUniqFM $ S.plusUFM tr1 tr2
 257
 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
 260 \end{code}
 261
 262 And ways of subtracting them. First the base cases,
 263 then the full D&C approach.
 264
 265 \begin{code}
 266 minusUFM (MkUniqFM fm1) (MkUniqFM fm2) = MkUniqFM $ S.minusUFM fm1 fm2
 267 \end{code}
 268
 269 And taking the intersection of two UniqFM's.
 270
 271 \begin{code}
 272 intersectUFM  (MkUniqFM t1) (MkUniqFM t2) = MkUniqFM $ S.intersectUFM t1 t2
 273 intersectsUFM (MkUniqFM t1) (MkUniqFM t2) = S.intersectsUFM t1 t2
 274
 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
 278 \end{code}
 279
 280 Now the usual set of `collection' operators, like map, fold, etc.
 281
 282 \begin{code}
 283 foldUFM f a (MkUniqFM ufm) = S.foldUFM f' a ufm
 284     where f' (Lazy elt) x = f elt x
 285 \end{code}
 286
 287 \begin{code}
 288 mapUFM fn (MkUniqFM fm) = MkUniqFM (S.mapUFM fn' fm)
 289     where fn' (Lazy elt) = Lazy (fn elt)
 290
 291 filterUFM fn (MkUniqFM fm) = MkUniqFM (S.filterUFM fn' fm)
 292     where fn' (Lazy elt) = fn elt
 293
 294 filterUFM_Directly fn (MkUniqFM fm) = MkUniqFM $ S.filterUFM_Directly fn' fm
 295     where fn' u (Lazy elt) = fn u elt
 296 \end{code}
 297
 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
 301 a finite map?
 302
 303 \begin{code}
 304 sizeUFM (MkUniqFM fm) = S.sizeUFM fm
 305
 306 isNullUFM (MkUniqFM fm) = S.isNullUFM fm
 307
 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
 311 \end{code}
 312
 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).
 315
 316 \begin{code}
 317 elemUFM          key (MkUniqFM fm) = S.elemUFM          key fm
 318 elemUFM_Directly key (MkUniqFM fm) = S.elemUFM_Directly key fm
 319
 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
 323
 324 lookupWithDefaultUFM (MkUniqFM fm) deflt key
 325     = fromLazy $ S.lookupWithDefaultUFM fm (Lazy deflt) key
 326
 327 lookupWithDefaultUFM_Directly (MkUniqFM fm) deflt key
 328  = fromLazy $ S.lookupWithDefaultUFM_Directly fm (Lazy deflt) key
 329 \end{code}
 330
 331 folds are *wonderful* things.
 332
 333 \begin{code}
 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
 340 \end{code}
 341