UniqSet.lhs 4.49 KB
Newer Older
1
%
Simon Marlow's avatar
Simon Marlow committed
2
% (c) The University of Glasgow 2006
3
% (c) The AQUA Project, Glasgow University, 1994-1998
4 5 6 7 8
%
\section[UniqSet]{Specialised sets, for things with @Uniques@}

Based on @UniqFMs@ (as you would expect).

9
Basically, the things need to be in class @Uniquable@.
10 11 12

\begin{code}
module UniqSet (
Ian Lynagh's avatar
Ian Lynagh committed
13 14 15 16 17 18 19 20 21
        UniqSet,    -- abstract type: NOT

        mkUniqSet, uniqSetToList, emptyUniqSet, unitUniqSet,
        addOneToUniqSet, addListToUniqSet,
        delOneFromUniqSet, delListFromUniqSet,
        unionUniqSets, unionManyUniqSets, minusUniqSet,
        elementOfUniqSet, mapUniqSet, intersectUniqSets,
        isEmptyUniqSet, filterUniqSet, sizeUniqSet, foldUniqSet,
        elemUniqSet_Directly, lookupUniqSet, hashUniqSet
22 23
    ) where

Ian Lynagh's avatar
Ian Lynagh committed
24
import Maybes
25
import UniqFM
Ian Lynagh's avatar
Ian Lynagh committed
26
import Unique
27

28 29 30 31 32 33 34 35
#if ! OMIT_NATIVE_CODEGEN
#define IF_NCG(a) a
#else
#define IF_NCG(a) {--}
#endif
\end{code}

%************************************************************************
Ian Lynagh's avatar
Ian Lynagh committed
36
%*                                                                      *
37
\subsection{The @UniqSet@ type}
Ian Lynagh's avatar
Ian Lynagh committed
38
%*                                                                      *
39 40
%************************************************************************

41
We use @UniqFM@, with a (@getUnique@-able) @Unique@ as ``key''
42 43 44 45 46 47 48 49 50 51 52
and the thing itself as the ``value'' (for later retrieval).

\begin{code}
--data UniqSet a = MkUniqSet (FiniteMap Unique a) : NOT

type UniqSet a = UniqFM a
#define MkUniqSet {--}

emptyUniqSet :: UniqSet a
emptyUniqSet = MkUniqSet emptyUFM

53
unitUniqSet :: Uniquable a => a -> UniqSet a
54
unitUniqSet x = MkUniqSet (unitUFM x x)
55 56

uniqSetToList :: UniqSet a -> [a]
57
uniqSetToList (MkUniqSet set) = eltsUFM set
58

59
foldUniqSet :: (a -> b -> b) -> b -> UniqSet a -> b
Ian Lynagh's avatar
Ian Lynagh committed
60
foldUniqSet k z (MkUniqSet set) = foldUFM k z set
61

62
mkUniqSet :: Uniquable a => [a]  -> UniqSet a
63 64
mkUniqSet xs = MkUniqSet (listToUFM [ (x, x) | x <- xs])

65
addOneToUniqSet :: Uniquable a => UniqSet a -> a -> UniqSet a
66 67
addOneToUniqSet (MkUniqSet set) x = MkUniqSet (addToUFM set x x)

68 69 70
delOneFromUniqSet :: Uniquable a => UniqSet a -> a -> UniqSet a
delOneFromUniqSet (MkUniqSet set) x = MkUniqSet (delFromUFM set x)

71 72 73
delListFromUniqSet :: Uniquable a => UniqSet a -> [a] -> UniqSet a
delListFromUniqSet (MkUniqSet set) xs = MkUniqSet (delListFromUFM set xs)

74 75
addListToUniqSet :: Uniquable a => UniqSet a -> [a] -> UniqSet a
addListToUniqSet (MkUniqSet set) xs = MkUniqSet (addListToUFM set [(x,x) | x<-xs])
76

77 78 79 80
unionUniqSets :: UniqSet a -> UniqSet a -> UniqSet a
unionUniqSets (MkUniqSet set1) (MkUniqSet set2) = MkUniqSet (plusUFM set1 set2)

unionManyUniqSets :: [UniqSet a] -> UniqSet a
Ian Lynagh's avatar
Ian Lynagh committed
81 82 83
-- = foldr unionUniqSets emptyUniqSet ss
unionManyUniqSets []     = emptyUniqSet
unionManyUniqSets [s]    = s
84 85 86 87 88
unionManyUniqSets (s:ss) = s `unionUniqSets` unionManyUniqSets ss

minusUniqSet  :: UniqSet a -> UniqSet a -> UniqSet a
minusUniqSet (MkUniqSet set1) (MkUniqSet set2) = MkUniqSet (minusUFM set1 set2)

89 90 91
filterUniqSet :: (a -> Bool) -> UniqSet a -> UniqSet a
filterUniqSet pred (MkUniqSet set) = MkUniqSet (filterUFM pred set)

92 93 94
intersectUniqSets :: UniqSet a -> UniqSet a -> UniqSet a
intersectUniqSets (MkUniqSet set1) (MkUniqSet set2) = MkUniqSet (intersectUFM set1 set2)

95
elementOfUniqSet :: Uniquable a => a -> UniqSet a -> Bool
96 97
elementOfUniqSet x (MkUniqSet set) = maybeToBool (lookupUFM set x)

98 99 100 101 102 103
lookupUniqSet :: Uniquable a => UniqSet a -> a -> Maybe a
lookupUniqSet (MkUniqSet set) x = lookupUFM set x

elemUniqSet_Directly :: Unique -> UniqSet a -> Bool
elemUniqSet_Directly x (MkUniqSet set) = maybeToBool (lookupUFM_Directly set x)

104 105 106
sizeUniqSet :: UniqSet a -> Int
sizeUniqSet (MkUniqSet set) = sizeUFM set

107 108 109
hashUniqSet :: UniqSet a -> Int
hashUniqSet (MkUniqSet set) = hashUFM set

110 111 112
isEmptyUniqSet :: UniqSet a -> Bool
isEmptyUniqSet (MkUniqSet set) = isNullUFM set {-SLOW: sizeUFM set == 0-}

113 114 115
mapUniqSet :: (a -> a) -> UniqSet a -> UniqSet a
  -- VERY IMPORTANT: *assumes* that the function doesn't change the unique
mapUniqSet f (MkUniqSet set) = MkUniqSet (mapUFM f set)
116 117 118 119 120
\end{code}

\begin{code}
#if __GLASGOW_HASKELL__
{-# SPECIALIZE
121
    addOneToUniqSet :: UniqSet Unique -> Unique -> UniqSet Unique
122
    #-}
123 124 125 126

-- These next three specialisations disabled as importing Name creates a
-- loop, and getting the Uniquable Name instance in particular is tricky.

sof's avatar
sof committed
127
{- SPECIALIZE
128
    elementOfUniqSet :: Name -> UniqSet Name -> Bool
Ian Lynagh's avatar
Ian Lynagh committed
129
                      , Unique -> UniqSet Unique -> Bool
sof's avatar
sof committed
130 131
    -}
{- SPECIALIZE
132
    mkUniqSet :: [Name] -> UniqSet Name
sof's avatar
sof committed
133
    -}
134

sof's avatar
sof committed
135
{- SPECIALIZE
136
    unitUniqSet :: Name -> UniqSet Name
Ian Lynagh's avatar
Ian Lynagh committed
137
                 , Unique -> UniqSet Unique
sof's avatar
sof committed
138
    -}
139 140
#endif
\end{code}