1 -- this is from ghc/syslib-ghc
    2 
    3 -- this is patched !!!
    4 
    5 -- renamed union -> unionSet, intersect -> intersectSet
    6 -- because it clashes with List.hs
    7 
    8 -- included filterSet function
    9 -- included mergeFM function
   10 
   11 -- added some specialisations
   12 
   13 module Set (
   14         -- not a synonym so we can make it abstract
   15         Set,
   16 
   17         mkSet, setToList, emptySet, singletonSet, unitSet,
   18         unionSet, unionManySets, minusSet,
   19         elementOf, mapSet,
   20         intersectSet, isEmptySet,
   21         intersectManySets,
   22         cardinality,
   23         
   24         filterSet,
   25 
   26         mergeFM
   27 
   28     ) where
   29 
   30 
   31 import FiniteMap
   32 import Maybes
   33 
   34 
   35 infixl 5 `unionSet`
   36 infixl 6 `intersectSet`
   37 
   38 
   39 -- import TA -- for specializations
   40 
   41 -- just to see if and how this works
   42 
   43 {- # SPECIALIZE mkSet :: [Int] -> Set Int #-}
   44 {- # SPECIALIZE mkSet :: [(Int, Int)] -> Set (Int, Int) #-}
   45 {- # SPECIALIZE mkSet :: [STerm Int] -> Set (STerm Int) #-}
   46 
   47 {- # SPECIALIZE setToList :: Set Int -> [Int] #-}
   48 {- # SPECIALIZE setToList :: Set (Int, Int) -> [(Int, Int)] #-}
   49 {- # SPECIALIZE setToList :: Set (STerm Int) -> [(STerm Int)] #-}
   50 
   51 --------------------------------------------------------------------
   52 
   53 -- This can't be a type synonym if you want to use constructor classes.
   54 newtype Set a = MkSet (FiniteMap a ())
   55 
   56 emptySet :: Set a
   57 emptySet = MkSet emptyFM
   58 
   59 unitSet :: a -> Set a
   60 unitSet x = MkSet (unitFM x ())
   61 singletonSet = unitSet -- old;deprecated?
   62 
   63 setToList :: Set a -> [a]
   64 setToList (MkSet set) = keysFM set
   65 
   66 mkSet :: Ord a => [a]  -> Set a
   67 mkSet xs = MkSet (listToFM [ (x, ()) | x <- xs])
   68 
   69 unionSet :: Ord a => Set a -> Set a -> Set a
   70 unionSet (MkSet set1) (MkSet set2) = MkSet (plusFM set1 set2)
   71 
   72 unionManySets :: Ord a => [Set a] -> Set a
   73 unionManySets ss = foldr unionSet emptySet ss
   74 
   75 minusSet  :: Ord a => Set a -> Set a -> Set a
   76 minusSet (MkSet set1) (MkSet set2) = MkSet (minusFM set1 set2)
   77 
   78 intersectSet :: Ord a => Set a -> Set a -> Set a
   79 intersectSet (MkSet set1) (MkSet set2) = MkSet (intersectFM set1 set2)
   80 
   81 intersectManySets :: Ord a => [Set a] -> Set a
   82 intersectManySets [] = emptySet -- STRANGE
   83 intersectManySets ss = foldr1 intersectSet ss
   84 
   85 elementOf :: Ord a => a -> Set a -> Bool
   86 elementOf x (MkSet set) = exists (lookupFM set x)
   87 
   88 isEmptySet :: Set a -> Bool
   89 isEmptySet (MkSet set) = sizeFM set == 0
   90 
   91 mapSet :: Ord a => (b -> a) -> Set b -> Set a
   92 mapSet f (MkSet set) = MkSet (listToFM [ (f key, ()) | key <- keysFM set ])
   93 
   94 cardinality :: Set a -> Int
   95 cardinality (MkSet set) = sizeFM set
   96 
   97 filterSet :: Ord a => (a -> Bool) -> Set a -> Set a
   98 filterSet p (MkSet set) = MkSet (filterFM (\ x _ -> p x) set)
   99 
  100 
  101 mergeFM :: (Ord a, Ord b) => 
  102         FiniteMap a (Set b) -> FiniteMap a (Set b) -> FiniteMap a (Set b)
  103 mergeFM l r = plusFM_C unionSet l r
  104 
  105 
  106 -- fair enough...
  107 instance (Eq a) => Eq (Set a) where
  108   (MkSet set_1) == (MkSet set_2) = set_1 == set_2
  109   (MkSet set_1) /= (MkSet set_2) = set_1 /= set_2
  110 
  111 -- but not so clear what the right thing to do is:
  112 {- NO:
  113 instance (Ord a) => Ord (Set a) where
  114   (MkSet set_1) <= (MkSet set_2) = set_1 <= set_2
  115 -}
  116 
  117 instance Ord a => Ord (Set a) where
  118         s <= t = setToList s <= setToList t
  119 
  120 
  121 instance Show a => Show (Set a) where 
  122     showsPrec p s = 
  123         showsPrec p (setToList s)
  124