compiler/utils/UniqSet.lhs

   1 %
   2 % (c) The University of Glasgow 2006
   3 % (c) The AQUA Project, Glasgow University, 1994-1998
   4 %
   5 \section[UniqSet]{Specialised sets, for things with @Uniques@}
   6
   7 Based on @UniqFMs@ (as you would expect).
   8
   9 Basically, the things need to be in class @Uniquable@.
  10
  11 \begin{code}
  12 {-# OPTIONS_GHC -w #-}
  13 -- The above warning supression flag is a temporary kludge.
  14 -- While working on this module you are encouraged to remove it and fix
  15 -- any warnings in the module. See
  16 --     http://hackage.haskell.org/trac/ghc/wiki/WorkingConventions#Warnings
  17 -- for details
  18
  19 module UniqSet (
  20         UniqSet,    -- abstract type: NOT
  21
  22         mkUniqSet, uniqSetToList, emptyUniqSet, unitUniqSet,
  23         addOneToUniqSet, addListToUniqSet, delOneFromUniqSet, delListFromUniqSet,
  24         unionUniqSets, unionManyUniqSets, minusUniqSet,
  25         elementOfUniqSet, mapUniqSet, intersectUniqSets,
  26         isEmptyUniqSet, filterUniqSet, sizeUniqSet, foldUniqSet,
  27         elemUniqSet_Directly, lookupUniqSet, hashUniqSet
  28     ) where
  29
  30 #include "HsVersions.h"
  31
  32 import Maybes           ( maybeToBool )
  33 import UniqFM
  34 import Unique           ( Unique, Uniquable(..) )
  35
  36 #if ! OMIT_NATIVE_CODEGEN
  37 #define IF_NCG(a) a
  38 #else
  39 #define IF_NCG(a) {--}
  40 #endif
  41 \end{code}
  42
  43 %************************************************************************
  44 %*                                                                      *
  45 \subsection{The @UniqSet@ type}
  46 %*                                                                      *
  47 %************************************************************************
  48
  49 We use @UniqFM@, with a (@getUnique@-able) @Unique@ as ``key''
  50 and the thing itself as the ``value'' (for later retrieval).
  51
  52 \begin{code}
  53 --data UniqSet a = MkUniqSet (FiniteMap Unique a) : NOT
  54
  55 type UniqSet a = UniqFM a
  56 #define MkUniqSet {--}
  57
  58 emptyUniqSet :: UniqSet a
  59 emptyUniqSet = MkUniqSet emptyUFM
  60
  61 unitUniqSet :: Uniquable a => a -> UniqSet a
  62 unitUniqSet x = MkUniqSet (unitUFM x x)
  63
  64 uniqSetToList :: UniqSet a -> [a]
  65 uniqSetToList (MkUniqSet set) = eltsUFM set
  66
  67 foldUniqSet :: (a -> b -> b) -> b -> UniqSet a -> b
  68 foldUniqSet k z (MkUniqSet set) = foldUFM k z set
  69
  70 mkUniqSet :: Uniquable a => [a]  -> UniqSet a
  71 mkUniqSet xs = MkUniqSet (listToUFM [ (x, x) | x <- xs])
  72
  73 addOneToUniqSet :: Uniquable a => UniqSet a -> a -> UniqSet a
  74 addOneToUniqSet (MkUniqSet set) x = MkUniqSet (addToUFM set x x)
  75
  76 delOneFromUniqSet :: Uniquable a => UniqSet a -> a -> UniqSet a
  77 delOneFromUniqSet (MkUniqSet set) x = MkUniqSet (delFromUFM set x)
  78
  79 delListFromUniqSet :: Uniquable a => UniqSet a -> [a] -> UniqSet a
  80 delListFromUniqSet (MkUniqSet set) xs = MkUniqSet (delListFromUFM set xs)
  81
  82 addListToUniqSet :: Uniquable a => UniqSet a -> [a] -> UniqSet a
  83 addListToUniqSet (MkUniqSet set) xs = MkUniqSet (addListToUFM set [(x,x) | x<-xs])
  84
  85 unionUniqSets :: UniqSet a -> UniqSet a -> UniqSet a
  86 unionUniqSets (MkUniqSet set1) (MkUniqSet set2) = MkUniqSet (plusUFM set1 set2)
  87
  88 unionManyUniqSets :: [UniqSet a] -> UniqSet a
  89         -- = foldr unionUniqSets emptyUniqSet ss
  90 unionManyUniqSets []     = emptyUniqSet
  91 unionManyUniqSets [s]    = s
  92 unionManyUniqSets (s:ss) = s `unionUniqSets` unionManyUniqSets ss
  93
  94 minusUniqSet  :: UniqSet a -> UniqSet a -> UniqSet a
  95 minusUniqSet (MkUniqSet set1) (MkUniqSet set2) = MkUniqSet (minusUFM set1 set2)
  96
  97 filterUniqSet :: (a -> Bool) -> UniqSet a -> UniqSet a
  98 filterUniqSet pred (MkUniqSet set) = MkUniqSet (filterUFM pred set)
  99
 100 intersectUniqSets :: UniqSet a -> UniqSet a -> UniqSet a
 101 intersectUniqSets (MkUniqSet set1) (MkUniqSet set2) = MkUniqSet (intersectUFM set1 set2)
 102
 103 elementOfUniqSet :: Uniquable a => a -> UniqSet a -> Bool
 104 elementOfUniqSet x (MkUniqSet set) = maybeToBool (lookupUFM set x)
 105
 106 lookupUniqSet :: Uniquable a => UniqSet a -> a -> Maybe a
 107 lookupUniqSet (MkUniqSet set) x = lookupUFM set x
 108
 109 elemUniqSet_Directly :: Unique -> UniqSet a -> Bool
 110 elemUniqSet_Directly x (MkUniqSet set) = maybeToBool (lookupUFM_Directly set x)
 111
 112 sizeUniqSet :: UniqSet a -> Int
 113 sizeUniqSet (MkUniqSet set) = sizeUFM set
 114
 115 hashUniqSet :: UniqSet a -> Int
 116 hashUniqSet (MkUniqSet set) = hashUFM set
 117
 118 isEmptyUniqSet :: UniqSet a -> Bool
 119 isEmptyUniqSet (MkUniqSet set) = isNullUFM set {-SLOW: sizeUFM set == 0-}
 120
 121 mapUniqSet :: (a -> a) -> UniqSet a -> UniqSet a
 122   -- VERY IMPORTANT: *assumes* that the function doesn't change the unique
 123 mapUniqSet f (MkUniqSet set) = MkUniqSet (mapUFM f set)
 124 \end{code}
 125
 126 \begin{code}
 127 #if __GLASGOW_HASKELL__
 128 {-# SPECIALIZE
 129     addOneToUniqSet :: UniqSet Unique -> Unique -> UniqSet Unique
 130     #-}
 131
 132 -- These next three specialisations disabled as importing Name creates a
 133 -- loop, and getting the Uniquable Name instance in particular is tricky.
 134
 135 {- SPECIALIZE
 136     elementOfUniqSet :: Name -> UniqSet Name -> Bool
 137                       , Unique -> UniqSet Unique -> Bool
 138     -}
 139 {- SPECIALIZE
 140     mkUniqSet :: [Name] -> UniqSet Name
 141     -}
 142
 143 {- SPECIALIZE
 144     unitUniqSet :: Name -> UniqSet Name
 145                  , Unique -> UniqSet Unique
 146     -}
 147 #endif
 148 \end{code}