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