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