ghc/compiler/utils/UniqSet.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1994-1996
   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 \begin{code}
  11 #include "HsVersions.h"
  12
  13 module UniqSet (
  14         UniqSet(..),    -- abstract type: NOT
  15
  16         mkUniqSet, uniqSetToList, emptyUniqSet, singletonUniqSet,
  17         unionUniqSets, unionManyUniqSets, minusUniqSet,
  18         elementOfUniqSet, mapUniqSet, intersectUniqSets,
  19         isEmptyUniqSet
  20     ) where
  21
  22 CHK_Ubiq() -- debugging consistency check
  23
  24 import Maybes           ( maybeToBool, Maybe )
  25 import UniqFM
  26 import Unique           ( Unique )
  27 import Outputable       ( Outputable(..), NamedThing(..), ExportFlag )
  28 import SrcLoc           ( SrcLoc )
  29 import Pretty           ( Pretty(..), PrettyRep )
  30 import PprStyle         ( PprStyle )
  31 import Util             ( Ord3(..) )
  32
  33 #if ! OMIT_NATIVE_CODEGEN
  34 #define IF_NCG(a) a
  35 #else
  36 #define IF_NCG(a) {--}
  37 #endif
  38 \end{code}
  39
  40 %************************************************************************
  41 %*                                                                      *
  42 \subsection{The @UniqSet@ type}
  43 %*                                                                      *
  44 %************************************************************************
  45
  46 We use @UniqFM@, with a (@getItsUnique@-able) @Unique@ as ``key''
  47 and the thing itself as the ``value'' (for later retrieval).
  48
  49 \begin{code}
  50 --data UniqSet a = MkUniqSet (FiniteMap Unique a) : NOT
  51
  52 type UniqSet a = UniqFM a
  53 #define MkUniqSet {--}
  54
  55 emptyUniqSet :: UniqSet a
  56 emptyUniqSet = MkUniqSet emptyUFM
  57
  58 singletonUniqSet :: NamedThing a => a -> UniqSet a
  59 singletonUniqSet x = MkUniqSet (singletonUFM x x)
  60
  61 uniqSetToList :: UniqSet a -> [a]
  62 uniqSetToList (MkUniqSet set) = eltsUFM set
  63
  64 mkUniqSet :: NamedThing a => [a]  -> UniqSet a
  65 mkUniqSet xs = MkUniqSet (listToUFM [ (x, x) | x <- xs])
  66
  67 unionUniqSets :: UniqSet a -> UniqSet a -> UniqSet a
  68 unionUniqSets (MkUniqSet set1) (MkUniqSet set2) = MkUniqSet (plusUFM set1 set2)
  69
  70 unionManyUniqSets :: [UniqSet a] -> UniqSet a
  71         -- = foldr unionUniqSets emptyUniqSet ss
  72 unionManyUniqSets []     = emptyUniqSet
  73 unionManyUniqSets [s]    = s
  74 unionManyUniqSets (s:ss) = s `unionUniqSets` unionManyUniqSets ss
  75
  76 minusUniqSet  :: UniqSet a -> UniqSet a -> UniqSet a
  77 minusUniqSet (MkUniqSet set1) (MkUniqSet set2) = MkUniqSet (minusUFM set1 set2)
  78
  79 intersectUniqSets :: UniqSet a -> UniqSet a -> UniqSet a
  80 intersectUniqSets (MkUniqSet set1) (MkUniqSet set2) = MkUniqSet (intersectUFM set1 set2)
  81
  82 elementOfUniqSet :: NamedThing a => a -> UniqSet a -> Bool
  83 elementOfUniqSet x (MkUniqSet set) = maybeToBool (lookupUFM set x)
  84
  85 isEmptyUniqSet :: UniqSet a -> Bool
  86 isEmptyUniqSet (MkUniqSet set) = isNullUFM set {-SLOW: sizeUFM set == 0-}
  87
  88 mapUniqSet :: NamedThing b => (a -> b) -> UniqSet a -> UniqSet b
  89 mapUniqSet f (MkUniqSet set)
  90   = MkUniqSet (listToUFM [ let
  91                              mapped_thing = f thing
  92                           in
  93                           (mapped_thing, mapped_thing)
  94                         | thing <- eltsUFM set ])
  95 \end{code}
  96
  97 %************************************************************************
  98 %*                                                                      *
  99 \subsection{The @IdSet@ and @TyVarSet@ specialisations for sets of Ids/TyVars}
 100 %*                                                                      *
 101 %************************************************************************
 102
 103 @IdSet@ is a specialised version, optimised for sets of Ids.
 104
 105 \begin{code}
 106 --type NameSet           = UniqSet Name
 107 --type GenTyVarSet flexi = UniqSet (GenTyVar flexi)
 108 --type GenIdSet ty       = UniqSet (GenId ty)
 109
 110 #if ! OMIT_NATIVE_CODEGEN
 111 --type RegSet   = UniqSet Reg
 112 #endif
 113
 114 #if 0
 115 #if __GLASGOW_HASKELL__
 116 {-# SPECIALIZE
 117     singletonUniqSet :: GenId ty       -> GenIdSet ty,
 118                         GenTyVar flexi -> GenTyVarSet flexi,
 119                         Name  -> NameSet
 120     IF_NCG(COMMA        Reg   -> RegSet)
 121     #-}
 122
 123 {-# SPECIALIZE
 124     mkUniqSet :: [GenId ty]    -> GenIdSet ty,
 125                  [GenTyVar flexi] -> GenTyVarSet flexi,
 126                  [Name]  -> NameSet
 127     IF_NCG(COMMA [Reg]   -> RegSet)
 128     #-}
 129
 130 {-# SPECIALIZE
 131     elementOfUniqSet :: GenId ty       -> GenIdSet ty       -> Bool,
 132                         GenTyVar flexi -> GenTyVarSet flexi -> Bool,
 133                         Name  -> NameSet  -> Bool
 134     IF_NCG(COMMA        Reg   -> RegSet   -> Bool)
 135     #-}
 136
 137 {-# SPECIALIZE
 138     mapUniqSet :: (GenId ty       -> GenId ty)       -> GenIdSet ty        -> GenIdSet ty,
 139                   (GenTyVar flexi -> GenTyVar flexi) -> GenTyVarSet flexi -> GenTyVarSet flexi,
 140                   (Name  -> Name)  -> NameSet  -> NameSet
 141     IF_NCG(COMMA  (Reg  -> Reg)    -> RegSet   -> RegSet)
 142     #-}
 143 #endif
 144 #endif
 145 \end{code}