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
|
%
% (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 (
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
) where
#include "HsVersions.h"
import {-# SOURCE #-} Name ( Name )
import Maybes ( maybeToBool )
import UniqFM
import Unique ( Unique, Uniquable(..) )
#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)
delOneFromUniqSet :: Uniquable a => UniqSet a -> a -> UniqSet a
delOneFromUniqSet (MkUniqSet set) x = MkUniqSet (delFromUFM set x)
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-}
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)
\end{code}
\begin{code}
#if __GLASGOW_HASKELL__
{-# SPECIALIZE
addOneToUniqSet :: UniqSet Unique -> Unique -> UniqSet Unique
#-}
{- 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}
|
