ghc/lib/ghc/Set.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1994
   3 %
   4 \section[Set]{An implementation of sets}
   5
   6 This new (94/04) implementation of sets sits squarely upon our
   7 implementation of @FiniteMaps@.  The interface is (roughly?) as
   8 before.
   9
  10 See also the @UniqSet@ module (sets of things from which you can
  11 extract a @Unique@).
  12
  13 \begin{code}
  14 #if defined(COMPILING_GHC) && defined(DEBUG_FINITEMAPS)
  15 #define OUTPUTABLE_a , Outputable a
  16 #else
  17 #define OUTPUTABLE_a {--}
  18 #endif
  19
  20 module Set (
  21 #if defined(__GLASGOW_HASKELL__)
  22         Set(..),    -- abstract type: NOT
  23 #else
  24         -- not a synonym so we can make it abstract
  25         Set,
  26 #endif
  27
  28         mkSet, setToList, emptySet, singletonSet,
  29         union, unionManySets, minusSet,
  30         elementOf, mapSet,
  31         intersect, isEmptySet
  32
  33         -- to make the interface self-sufficient
  34 #if defined(__GLASGOW_HASKELL__)
  35         , FiniteMap   -- abstract
  36
  37         -- for pragmas
  38         , intersectFM, minusFM, keysFM, plusFM
  39 #endif
  40     ) where
  41
  42 import FiniteMap
  43 import Maybes           ( maybeToBool
  44 #if __HASKELL1__ < 3
  45                           , Maybe(..)
  46 #endif
  47                         )
  48 #if defined(__GLASGOW_HASKELL__)
  49 -- I guess this is here so that our friend USE_ATTACK_PRAGMAS can
  50 -- do his job of seeking out and destroying information hiding. ADR
  51 import Util             --OLD: hiding ( Set(..), emptySet )
  52 #endif
  53
  54 #if defined(COMPILING_GHC)
  55 import Outputable
  56 #endif
  57 \end{code}
  58
  59 \begin{code}
  60 #if defined(__GLASGOW_HASKELL__)
  61
  62 type Set a = FiniteMap a ()
  63
  64 #define MkSet {--}
  65
  66 #else
  67 -- This can't be a type synonym if you want to use constructor classes.
  68 data Set a = MkSet (FiniteMap a ()) {-# STRICT #-}
  69 #endif
  70
  71 emptySet :: Set a
  72 emptySet = MkSet emptyFM
  73
  74 singletonSet :: a -> Set a
  75 singletonSet x = MkSet (singletonFM x ())
  76
  77 setToList :: Set a -> [a]
  78 setToList (MkSet set) = keysFM set
  79
  80 mkSet :: (Ord a OUTPUTABLE_a) => [a]  -> Set a
  81 mkSet xs = MkSet (listToFM [ (x, ()) | x <- xs])
  82
  83 union :: (Ord a OUTPUTABLE_a) => Set a -> Set a -> Set a
  84 union (MkSet set1) (MkSet set2) = MkSet (plusFM set1 set2)
  85
  86 unionManySets :: (Ord a OUTPUTABLE_a) => [Set a] -> Set a
  87 unionManySets ss = foldr union emptySet ss
  88
  89 minusSet  :: (Ord a OUTPUTABLE_a) => Set a -> Set a -> Set a
  90 minusSet (MkSet set1) (MkSet set2) = MkSet (minusFM set1 set2)
  91
  92 intersect :: (Ord a OUTPUTABLE_a) => Set a -> Set a -> Set a
  93 intersect (MkSet set1) (MkSet set2) = MkSet (intersectFM set1 set2)
  94
  95 elementOf :: (Ord a OUTPUTABLE_a) => a -> Set a -> Bool
  96 elementOf x (MkSet set) = maybeToBool(lookupFM set x)
  97
  98 isEmptySet :: Set a -> Bool
  99 isEmptySet (MkSet set) = sizeFM set == 0
 100
 101 mapSet :: (Ord a OUTPUTABLE_a) => (b -> a) -> Set b -> Set a
 102 mapSet f (MkSet set) = MkSet (listToFM [ (f key, ()) | key <- keysFM set ])
 103 \end{code}