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 @Uniquable@.
   9
  10 \begin{code}
  11 #include "HsVersions.h"
  12
  13 module UniqSet (
  14         SYN_IE(UniqSet),    -- abstract type: NOT
  15
  16         mkUniqSet, uniqSetToList, emptyUniqSet, unitUniqSet,
  17         addOneToUniqSet, addListToUniqSet,
  18         unionUniqSets, unionManyUniqSets, minusUniqSet,
  19         elementOfUniqSet, mapUniqSet, intersectUniqSets,
  20         isEmptyUniqSet, filterUniqSet, sizeUniqSet
  21     ) where
  22
  23 #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ <= 201
  24 IMPORT_DELOOPER( SpecLoop )
  25 #else
  26 import {-# SOURCE #-} Name
  27 #endif
  28
  29 import Maybes           ( maybeToBool )
  30 import UniqFM
  31 import Unique           ( Unique, Uniquable(..) )
  32 import SrcLoc           ( SrcLoc )
  33 import Outputable       ( PprStyle, Outputable(..) )
  34 import Pretty           ( Doc )
  35 import Util             ( Ord3(..) )
  36
  37 #if ! OMIT_NATIVE_CODEGEN
  38 #define IF_NCG(a) a
  39 #else
  40 #define IF_NCG(a) {--}
  41 #endif
  42 \end{code}
  43
  44 %************************************************************************
  45 %*                                                                      *
  46 \subsection{The @UniqSet@ type}
  47 %*                                                                      *
  48 %************************************************************************
  49
  50 We use @UniqFM@, with a (@uniqueOf@-able) @Unique@ as ``key''
  51 and the thing itself as the ``value'' (for later retrieval).
  52
  53 \begin{code}
  54 --data UniqSet a = MkUniqSet (FiniteMap Unique a) : NOT
  55
  56 type UniqSet a = UniqFM a
  57 #define MkUniqSet {--}
  58
  59 emptyUniqSet :: UniqSet a
  60 emptyUniqSet = MkUniqSet emptyUFM
  61
  62 unitUniqSet :: Uniquable a => a -> UniqSet a
  63 unitUniqSet x = MkUniqSet (unitUFM x x)
  64
  65 uniqSetToList :: UniqSet a -> [a]
  66 uniqSetToList (MkUniqSet set) = eltsUFM set
  67
  68 mkUniqSet :: Uniquable a => [a]  -> UniqSet a
  69 mkUniqSet xs = MkUniqSet (listToUFM [ (x, x) | x <- xs])
  70
  71 addOneToUniqSet :: Uniquable a => UniqSet a -> a -> UniqSet a
  72 addOneToUniqSet (MkUniqSet set) x = MkUniqSet (addToUFM set x x)
  73
  74 addListToUniqSet :: Uniquable a => UniqSet a -> [a] -> UniqSet a
  75 addListToUniqSet (MkUniqSet set) xs = MkUniqSet (addListToUFM set [(x,x) | x<-xs])
  76
  77 unionUniqSets :: UniqSet a -> UniqSet a -> UniqSet a
  78 unionUniqSets (MkUniqSet set1) (MkUniqSet set2) = MkUniqSet (plusUFM set1 set2)
  79
  80 unionManyUniqSets :: [UniqSet a] -> UniqSet a
  81         -- = foldr unionUniqSets emptyUniqSet ss
  82 unionManyUniqSets []     = emptyUniqSet
  83 unionManyUniqSets [s]    = s
  84 unionManyUniqSets (s:ss) = s `unionUniqSets` unionManyUniqSets ss
  85
  86 minusUniqSet  :: UniqSet a -> UniqSet a -> UniqSet a
  87 minusUniqSet (MkUniqSet set1) (MkUniqSet set2) = MkUniqSet (minusUFM set1 set2)
  88
  89 filterUniqSet :: (a -> Bool) -> UniqSet a -> UniqSet a
  90 filterUniqSet pred (MkUniqSet set) = MkUniqSet (filterUFM pred set)
  91
  92 intersectUniqSets :: UniqSet a -> UniqSet a -> UniqSet a
  93 intersectUniqSets (MkUniqSet set1) (MkUniqSet set2) = MkUniqSet (intersectUFM set1 set2)
  94
  95 elementOfUniqSet :: Uniquable a => a -> UniqSet a -> Bool
  96 elementOfUniqSet x (MkUniqSet set) = maybeToBool (lookupUFM set x)
  97
  98 sizeUniqSet :: UniqSet a -> Int
  99 sizeUniqSet (MkUniqSet set) = sizeUFM set
 100
 101 isEmptyUniqSet :: UniqSet a -> Bool
 102 isEmptyUniqSet (MkUniqSet set) = isNullUFM set {-SLOW: sizeUFM set == 0-}
 103
 104 mapUniqSet :: Uniquable b => (a -> b) -> UniqSet a -> UniqSet b
 105 mapUniqSet f (MkUniqSet set)
 106   = MkUniqSet (listToUFM [ let
 107                              mapped_thing = f thing
 108                           in
 109                           (mapped_thing, mapped_thing)
 110                         | thing <- eltsUFM set ])
 111 \end{code}
 112
 113 \begin{code}
 114 #if __GLASGOW_HASKELL__
 115 {-# SPECIALIZE
 116     addOneToUniqSet :: UniqSet Unique -> Unique -> UniqSet Unique
 117     #-}
 118 {-# SPECIALIZE
 119     elementOfUniqSet :: Name -> UniqSet Name -> Bool
 120                       , Unique -> UniqSet Unique -> Bool
 121     #-}
 122 {-# SPECIALIZE
 123     mkUniqSet :: [Name] -> UniqSet Name
 124     #-}
 125
 126 {-# SPECIALIZE
 127     unitUniqSet :: Name -> UniqSet Name
 128                  , Unique -> UniqSet Unique
 129     #-}
 130 #endif
 131 \end{code}