ghc/compiler/utils/UniqSet.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1994-1995
   3 %
   4 \section[UniqSet]{Specialised sets, for things with @Uniques@}
   5
   6 Based on @UniqFMs@ (as you would expect).
   7
   8 Basically, the things need to be in class @NamedThing@.
   9
  10 We also export specialisations for @Ids@ and @TyVars@.
  11
  12 \begin{code}
  13 #include "HsVersions.h"
  14
  15 module UniqSet (
  16         UniqSet(..),    -- abstract type: NOT
  17
  18         mkUniqSet, uniqSetToList, emptyUniqSet, singletonUniqSet,
  19         unionUniqSets, unionManyUniqSets, minusUniqSet,
  20         elementOfUniqSet, mapUniqSet,
  21         intersectUniqSets, isEmptyUniqSet,
  22
  23         -- specalised for Ids:
  24         IdSet(..),
  25
  26         -- specalised for TyVars:
  27         TyVarSet(..),
  28
  29         -- specalised for Names:
  30         NameSet(..),
  31
  32         -- to make the interface self-sufficient
  33         Id, TyVar, Name,
  34
  35         UniqFM, Unique
  36
  37         -- and to be pragma friendly
  38 #ifdef USE_ATTACK_PRAGMAS
  39         , emptyUFM, intersectUFM, isNullUFM, minusUFM, singletonUFM,
  40         plusUFM, eltsUFM,
  41         u2i
  42 #endif
  43     ) where
  44
  45 import UniqFM
  46 import Id               -- for specialisation to Ids
  47 import IdInfo           -- sigh
  48 import Maybes           ( maybeToBool, Maybe(..) )
  49 import Name
  50 import Outputable
  51 import AbsUniType       -- for specialisation to TyVars
  52 import Util
  53 #if ! OMIT_NATIVE_CODEGEN
  54 import AsmRegAlloc      ( Reg )
  55 #define IF_NCG(a) a
  56 #else
  57 #define IF_NCG(a) {--}
  58 #endif
  59 \end{code}
  60
  61 %************************************************************************
  62 %*                                                                      *
  63 \subsection{The @UniqSet@ type}
  64 %*                                                                      *
  65 %************************************************************************
  66
  67 We use @UniqFM@, with a (@getTheUnique@-able) @Unique@ as ``key''
  68 and the thing itself as the ``value'' (for later retrieval).
  69
  70 \begin{code}
  71 --data UniqSet a = MkUniqSet (FiniteMap Unique a) : NOT
  72
  73 type UniqSet a = UniqFM a
  74 #define MkUniqSet {--}
  75
  76 emptyUniqSet :: UniqSet a
  77 emptyUniqSet = MkUniqSet emptyUFM
  78
  79 singletonUniqSet :: NamedThing a => a -> UniqSet a
  80 singletonUniqSet x = MkUniqSet (singletonUFM x x)
  81
  82 uniqSetToList :: UniqSet a -> [a]
  83 uniqSetToList (MkUniqSet set) = BSCC("uniqSetToList") eltsUFM set ESCC
  84
  85 mkUniqSet :: NamedThing a => [a]  -> UniqSet a
  86 mkUniqSet xs = MkUniqSet (listToUFM [ (x, x) | x <- xs])
  87
  88 unionUniqSets :: UniqSet a -> UniqSet a -> UniqSet a
  89 unionUniqSets (MkUniqSet set1) (MkUniqSet set2) = MkUniqSet (plusUFM set1 set2)
  90
  91 unionManyUniqSets :: [UniqSet a] -> UniqSet a
  92         -- = foldr unionUniqSets emptyUniqSet ss
  93 unionManyUniqSets []     = emptyUniqSet
  94 unionManyUniqSets [s]    = s
  95 unionManyUniqSets (s:ss) = s `unionUniqSets` unionManyUniqSets ss
  96
  97 minusUniqSet  :: UniqSet a -> UniqSet a -> UniqSet a
  98 minusUniqSet (MkUniqSet set1) (MkUniqSet set2) = MkUniqSet (minusUFM set1 set2)
  99
 100 intersectUniqSets :: UniqSet a -> UniqSet a -> UniqSet a
 101 intersectUniqSets (MkUniqSet set1) (MkUniqSet set2) = MkUniqSet (intersectUFM set1 set2)
 102
 103 elementOfUniqSet :: NamedThing a => a -> UniqSet a -> Bool
 104 elementOfUniqSet x (MkUniqSet set) = maybeToBool (lookupUFM set x)
 105
 106 isEmptyUniqSet :: UniqSet a -> Bool
 107 isEmptyUniqSet (MkUniqSet set) = isNullUFM set {-SLOW: sizeUFM set == 0-}
 108
 109 mapUniqSet :: NamedThing b => (a -> b) -> UniqSet a -> UniqSet b
 110 mapUniqSet f (MkUniqSet set)
 111   = MkUniqSet (listToUFM [ let
 112                              mapped_thing = f thing
 113                           in
 114                           (mapped_thing, mapped_thing)
 115                         | thing <- eltsUFM set ])
 116 \end{code}
 117
 118 %************************************************************************
 119 %*                                                                      *
 120 \subsection{The @IdSet@ and @TyVarSet@ specialisations for sets of Ids/TyVars}
 121 %*                                                                      *
 122 %************************************************************************
 123
 124 @IdSet@ is a specialised version, optimised for sets of Ids.
 125
 126 \begin{code}
 127 type IdSet    = UniqSet Id
 128 type TyVarSet = UniqSet TyVar
 129 type NameSet  = UniqSet Name
 130 #if ! OMIT_NATIVE_CODEGEN
 131 type RegSet   = UniqSet Reg
 132 #endif
 133
 134 #if __GLASGOW_HASKELL__
 135     -- avoid hbc bug (0.999.7)
 136 {-# SPECIALIZE
 137     singletonUniqSet :: Id    -> IdSet,
 138                         TyVar -> TyVarSet,
 139                         Name  -> NameSet
 140     IF_NCG(COMMA        Reg   -> RegSet)
 141     #-}
 142
 143 {-# SPECIALIZE
 144     mkUniqSet :: [Id]    -> IdSet,
 145                  [TyVar] -> TyVarSet,
 146                  [Name]  -> NameSet
 147     IF_NCG(COMMA [Reg]   -> RegSet)
 148     #-}
 149
 150 {-# SPECIALIZE
 151     elementOfUniqSet :: Id    -> IdSet    -> Bool,
 152                         TyVar -> TyVarSet -> Bool,
 153                         Name  -> NameSet  -> Bool
 154     IF_NCG(COMMA        Reg   -> RegSet   -> Bool)
 155     #-}
 156
 157 {-# SPECIALIZE
 158     mapUniqSet :: (Id    -> Id)    -> IdSet    -> IdSet,
 159                   (TyVar -> TyVar) -> TyVarSet -> TyVarSet,
 160                   (Name  -> Name)  -> NameSet  -> NameSet
 161     IF_NCG(COMMA  (Reg  -> Reg)    -> RegSet   -> RegSet)
 162     #-}
 163 #endif
 164 \end{code}