UniqFM.lhs 8.25 KB
Newer Older
Simon Marlow's avatar
Simon Marlow committed
1
2
%
% (c) The University of Glasgow 2006
3
% (c) The AQUA Project, Glasgow University, 1994-1998
4
%
Simon Marlow's avatar
Simon Marlow committed
5

6
UniqFM: Specialised finite maps, for things with @Uniques@.
7

8
Basically, the things need to be in class @Uniquable@, and we use the
9
@getUnique@ method to grab their @Uniques@.
10
11
12

(A similar thing to @UniqSet@, as opposed to @Set@.)

13
14
15
16
17
18
19
20
21
The interface is based on @FiniteMap@s, but the implementation uses
@Data.IntMap@, which is both maitained and faster than the past
implementation (see commit log).

The @UniqFM@ interface maps directly to Data.IntMap, only
``Data.IntMap.union'' is left-biased and ``plusUFM'' right-biased
and ``addToUFM\_C'' and ``Data.IntMap.insertWith'' differ in the order
of arguments of combining function.

22
\begin{code}
23
{-# OPTIONS -Wall #-}
24
module UniqFM (
25
	-- * Unique-keyed mappings
26
	UniqFM,       -- abstract type
27

28
        -- ** Manipulating those mappings
29
	emptyUFM,
30
31
	unitUFM,
	unitDirectlyUFM,
32
33
	listToUFM,
	listToUFM_Directly,
34
	listToUFM_C,
35
	addToUFM,addToUFM_C,addToUFM_Acc,
36
	addListToUFM,addListToUFM_C,
37
	addToUFM_Directly,
38
	addListToUFM_Directly,
39
	delFromUFM,
40
	delFromUFM_Directly,
41
42
43
44
45
	delListFromUFM,
	plusUFM,
	plusUFM_C,
	minusUFM,
	intersectUFM,
sof's avatar
sof committed
46
	intersectUFM_C,
47
	foldUFM, foldUFM_Directly,
48
	mapUFM,
49
	elemUFM, elemUFM_Directly,
50
	filterUFM, filterUFM_Directly,
51
52
	sizeUFM,
	isNullUFM,
53
54
	lookupUFM, lookupUFM_Directly,
	lookupWithDefaultUFM, lookupWithDefaultUFM_Directly,
55
	eltsUFM, keysUFM, splitUFM,
56
	ufmToList 
57
58
    ) where

59
import Unique           ( Uniquable(..), Unique, getKey )
60
import Outputable
61
62

import qualified Data.IntMap as M
63
64
65
66
\end{code}

%************************************************************************
%*									*
67
\subsection{The signature of the module}
68
69
70
71
72
73
%*									*
%************************************************************************

\begin{code}
emptyUFM	:: UniqFM elt
isNullUFM	:: UniqFM elt -> Bool
74
unitUFM		:: Uniquable key => key -> elt -> UniqFM elt
75
unitDirectlyUFM -- got the Unique already
76
		:: Unique -> elt -> UniqFM elt
77
listToUFM	:: Uniquable key => [(key,elt)] -> UniqFM elt
78
79
listToUFM_Directly
		:: [(Unique, elt)] -> UniqFM elt
80
81
82
listToUFM_C     :: Uniquable key => (elt -> elt -> elt) 
                           -> [(key, elt)] 
                           -> UniqFM elt
83

84
85
addToUFM	:: Uniquable key => UniqFM elt -> key -> elt  -> UniqFM elt
addListToUFM	:: Uniquable key => UniqFM elt -> [(key,elt)] -> UniqFM elt
86
addListToUFM_Directly :: UniqFM elt -> [(Unique,elt)] -> UniqFM elt
87
88
89
addToUFM_Directly
		:: UniqFM elt -> Unique -> elt -> UniqFM elt

90
91
92
93
94
addToUFM_C	:: Uniquable key => (elt -> elt -> elt)	-- old -> new -> result
			   -> UniqFM elt 		-- old
			   -> key -> elt 		-- new
			   -> UniqFM elt		-- result

95
96
97
98
99
100
101
addToUFM_Acc	:: Uniquable key =>
			      (elt -> elts -> elts)	-- Add to existing
			   -> (elt -> elts)		-- New element
			   -> UniqFM elts 		-- old
			   -> key -> elt 		-- new
			   -> UniqFM elts		-- result

102
addListToUFM_C	:: Uniquable key => (elt -> elt -> elt)
103
104
105
			   -> UniqFM elt -> [(key,elt)]
			   -> UniqFM elt

106
107
delFromUFM	:: Uniquable key => UniqFM elt -> key	 -> UniqFM elt
delListFromUFM	:: Uniquable key => UniqFM elt -> [key] -> UniqFM elt
108
delFromUFM_Directly :: UniqFM elt -> Unique -> UniqFM elt
109

110
-- Bindings in right argument shadow those in the left
111
112
113
114
115
plusUFM		:: UniqFM elt -> UniqFM elt -> UniqFM elt

plusUFM_C	:: (elt -> elt -> elt)
		-> UniqFM elt -> UniqFM elt -> UniqFM elt

116
minusUFM	:: UniqFM elt1 -> UniqFM elt2 -> UniqFM elt1
117
118

intersectUFM	:: UniqFM elt -> UniqFM elt -> UniqFM elt
119
120
intersectUFM_C	:: (elt1 -> elt2 -> elt3)
		-> UniqFM elt1 -> UniqFM elt2 -> UniqFM elt3
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
121

122
foldUFM		:: (elt -> a -> a) -> a -> UniqFM elt -> a
123
foldUFM_Directly:: (Unique -> elt -> a -> a) -> a -> UniqFM elt -> a
124
125
mapUFM		:: (elt1 -> elt2) -> UniqFM elt1 -> UniqFM elt2
filterUFM	:: (elt -> Bool) -> UniqFM elt -> UniqFM elt
126
filterUFM_Directly :: (Unique -> elt -> Bool) -> UniqFM elt -> UniqFM elt
127
128

sizeUFM		:: UniqFM elt -> Int
129
--hashUFM		:: UniqFM elt -> Int
130
elemUFM		:: Uniquable key => key -> UniqFM elt -> Bool
131
elemUFM_Directly:: Unique -> UniqFM elt -> Bool
132

133
134
splitUFM        :: Uniquable key => UniqFM elt -> key -> (UniqFM elt, Maybe elt, UniqFM elt)
		   -- Splits a UFM into things less than, equal to, and greater than the key
135
lookupUFM	:: Uniquable key => UniqFM elt -> key -> Maybe elt
136
lookupUFM_Directly  -- when you've got the Unique already
137
138
		:: UniqFM elt -> Unique -> Maybe elt
lookupWithDefaultUFM
139
		:: Uniquable key => UniqFM elt -> elt -> key -> elt
140
141
lookupWithDefaultUFM_Directly
		:: UniqFM elt -> elt -> Unique -> elt
142
keysUFM		:: UniqFM elt -> [Unique]	-- Get the keys
143
144
145
146
147
148
eltsUFM		:: UniqFM elt -> [elt]
ufmToList	:: UniqFM elt -> [(Unique, elt)]

\end{code}

%************************************************************************
149
150
151
%*                                                                      *
\subsection{Implementation using ``Data.IntMap''}
%*                                                                      *
152
153
154
%************************************************************************

\begin{code}
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
newtype UniqFM ele = UFM (M.IntMap ele)

emptyUFM = UFM M.empty
isNullUFM (UFM m) = M.null m
unitUFM k v = UFM (M.singleton (getKey $ getUnique k) v)
unitDirectlyUFM u v = UFM (M.singleton (getKey u) v)
listToUFM = foldl (\m (k, v) -> addToUFM m k v) emptyUFM
listToUFM_Directly = foldl (\m (u, v) -> addToUFM_Directly m u v) emptyUFM
listToUFM_C f = foldl (\m (k, v) -> addToUFM_C f m k v) emptyUFM

addToUFM (UFM m) k v = UFM (M.insert (getKey $ getUnique k) v m)
addListToUFM = foldl (\m (k, v) -> addToUFM m k v)
addListToUFM_Directly = foldl (\m (k, v) -> addToUFM_Directly m k v)
addToUFM_Directly (UFM m) u v = UFM (M.insert (getKey u) v m)

-- Arguments of combining function of M.insertWith and addToUFM_C are flipped.
addToUFM_C f (UFM m) k v =
  UFM (M.insertWith (flip f) (getKey $ getUnique k) v m)
addToUFM_Acc exi new (UFM m) k v =
  UFM (M.insertWith (\_new old -> exi v old) (getKey $ getUnique k) (new v) m)
addListToUFM_C f = foldl (\m (k, v) -> addToUFM_C f m k v)

delFromUFM (UFM m) k = UFM (M.delete (getKey $ getUnique k) m)
delListFromUFM = foldl delFromUFM
delFromUFM_Directly (UFM m) u = UFM (M.delete (getKey u) m)

-- M.union is left-biased, plusUFM should be right-biased.
plusUFM (UFM x) (UFM y) = UFM (M.union y x)
plusUFM_C f (UFM x) (UFM y) = UFM (M.unionWith f x y)
minusUFM (UFM x) (UFM y) = UFM (M.difference x y)
intersectUFM (UFM x) (UFM y) = UFM (M.intersection x y)
Ian Lynagh's avatar
Ian Lynagh committed
186
#if __GLASGOW_HASKELL__ >= 611
187
intersectUFM_C f (UFM x) (UFM y) = UFM (M.intersectionWith f x y)
Ian Lynagh's avatar
Ian Lynagh committed
188
189
190
191
192
193
194
195
196
197
198
199
#else
-- In GHC 6.10, intersectionWith is (a -> b -> a) instead of (a -> b -> c),
-- so we need to jump through some hoops to get the more general type.
intersectUFM_C f (UFM x) (UFM y) = UFM z
    where z = let x' = M.map Left x
                  f' (Left a) b = Right (f a b)
                  f' (Right _) _ = panic "intersectUFM_C: f': Right"
                  z' = M.intersectionWith f' x' y
                  fromRight (Right a) = a
                  fromRight _ = panic "intersectUFM_C: Left"
              in M.map fromRight z'
#endif
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219

foldUFM k z (UFM m) = M.fold k z m
foldUFM_Directly k z (UFM m) = M.foldWithKey (k . getUnique) z m
mapUFM f (UFM m) = UFM (M.map f m)
filterUFM p (UFM m) = UFM (M.filter p m)
filterUFM_Directly p (UFM m) = UFM (M.filterWithKey (p . getUnique) m)

sizeUFM (UFM m) = M.size m
elemUFM k (UFM m) = M.member (getKey $ getUnique k) m
elemUFM_Directly u (UFM m) = M.member (getKey u) m

splitUFM (UFM m) k = case M.splitLookup (getKey $ getUnique k) m of
                       (less, equal, greater) -> (UFM less, equal, UFM greater)
lookupUFM (UFM m) k = M.lookup (getKey $ getUnique k) m
lookupUFM_Directly (UFM m) u = M.lookup (getKey u) m
lookupWithDefaultUFM (UFM m) v k = M.findWithDefault v (getKey $ getUnique k) m
lookupWithDefaultUFM_Directly (UFM m) v u = M.findWithDefault v (getKey u) m
keysUFM (UFM m) = map getUnique $ M.keys m
eltsUFM (UFM m) = M.elems m
ufmToList (UFM m) = map (\(k, v) -> (getUnique k, v)) $ M.toList m
220
221
222
223

\end{code}

%************************************************************************
224
225
226
%*                                                                      *
\subsection{Output-ery}
%*                                                                      *
227
228
229
%************************************************************************

\begin{code}
230
231
instance Outputable a => Outputable (UniqFM a) where
    ppr ufm = ppr (ufmToList ufm)
232
\end{code}