Ensure runhaskell is rebuild in stage2
[ghc-hetmet.git] / 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 module UniqSet (
13         UniqSet,    -- abstract type: NOT
14
15         mkUniqSet, uniqSetToList, emptyUniqSet, unitUniqSet,
16         addOneToUniqSet, addListToUniqSet, addOneToUniqSet_C,
17         delOneFromUniqSet, delListFromUniqSet, delOneFromUniqSet_Directly,
18         unionUniqSets, unionManyUniqSets, minusUniqSet,
19         elementOfUniqSet, mapUniqSet, intersectUniqSets,
20         isEmptyUniqSet, filterUniqSet, sizeUniqSet, foldUniqSet,
21         elemUniqSet_Directly, lookupUniqSet, hashUniqSet
22     ) where
23
24 import Maybes
25 import UniqFM
26 import Unique
27
28 #if ! OMIT_NATIVE_CODEGEN
29 #define IF_NCG(a) a
30 #else
31 #define IF_NCG(a) {--}
32 #endif
33 \end{code}
34
35 %************************************************************************
36 %*                                                                      *
37 \subsection{The @UniqSet@ type}
38 %*                                                                      *
39 %************************************************************************
40
41 We use @UniqFM@, with a (@getUnique@-able) @Unique@ as ``key''
42 and the thing itself as the ``value'' (for later retrieval).
43
44 \begin{code}
45 --data UniqSet a = MkUniqSet (FiniteMap Unique a) : NOT
46
47 type UniqSet a = UniqFM a
48 #define MkUniqSet {--}
49
50 emptyUniqSet :: UniqSet a
51 emptyUniqSet = MkUniqSet emptyUFM
52
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
60 foldUniqSet k z (MkUniqSet set) = foldUFM k z set
61
62 mkUniqSet :: Uniquable a => [a]  -> UniqSet a
63 mkUniqSet xs = MkUniqSet (listToUFM [ (x, x) | x <- xs])
64
65 addOneToUniqSet :: Uniquable a => UniqSet a -> a -> UniqSet a
66 addOneToUniqSet (MkUniqSet set) x = MkUniqSet (addToUFM set x x)
67
68 addOneToUniqSet_C :: Uniquable a
69                   => (a -> a -> a) -> UniqSet a -> a -> UniqSet a
70 addOneToUniqSet_C f (MkUniqSet set) x = MkUniqSet (addToUFM_C f set x x)
71
72 delOneFromUniqSet :: Uniquable a => UniqSet a -> a -> UniqSet a
73 delOneFromUniqSet (MkUniqSet set) x = MkUniqSet (delFromUFM set x)
74
75 delOneFromUniqSet_Directly :: Uniquable a => UniqSet a -> Unique -> UniqSet a
76 delOneFromUniqSet_Directly (MkUniqSet set) u
77     = MkUniqSet (delFromUFM_Directly set u)
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 #ifdef __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}