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