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
151
152
153
154
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
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
|
%
% (c) The University of Glasgow 2006
% (c) The AQUA Project, Glasgow University, 1994-1998
%
``Finite maps'' are the heart of the compiler's lookup-tables/environments
and its implementation of sets. Important stuff!
The implementation uses @Data.Map@ from the containers package, which
is both maintained and faster than the past implementation (see commit log).
The orinigal interface is being kept around. It maps directly to Data.Map,
only ``Data.Map.union'' is left-biased and ``plusFM'' right-biased and
``addToFM\_C'' and ``Data.Map.insertWith'' differ in the order of
arguments of combining function.
\begin{code}
module FiniteMap (
-- * Mappings keyed from arbitrary types
FiniteMap, -- abstract data type
-- ** Manipulating those mappings
emptyFM, unitFM, listToFM,
addToFM,
addToFM_C,
addListToFM,
addListToFM_C,
delFromFM,
delListFromFM,
plusFM,
plusFM_C,
minusFM,
foldFM,
intersectFM,
intersectFM_C,
mapFM, filterFM,
sizeFM, isEmptyFM, elemFM, lookupFM, lookupWithDefaultFM,
fmToList, keysFM, eltsFM,
bagToFM
) where
import Bag ( Bag, foldrBag )
import Outputable
import qualified Data.Map as M
\end{code}
%************************************************************************
%* *
\subsection{The signature of the module}
%* *
%************************************************************************
\begin{code}
-- BUILDING
emptyFM :: FiniteMap key elt
unitFM :: key -> elt -> FiniteMap key elt
-- | In the case of duplicates keys, the last item is taken
listToFM :: (Ord key) => [(key,elt)] -> FiniteMap key elt
-- | In the case of duplicate keys, who knows which item is taken
bagToFM :: (Ord key) => Bag (key,elt) -> FiniteMap key elt
-- ADDING AND DELETING
-- | Throws away any previous binding
addToFM :: (Ord key)
=> FiniteMap key elt -> key -> elt -> FiniteMap key elt
-- | Throws away any previous binding, items are added left-to-right
addListToFM :: (Ord key)
=> FiniteMap key elt -> [(key,elt)] -> FiniteMap key elt
-- | Combines added item with previous item, if any --
-- if the key is present, ``addToFM_C f`` inserts
-- ``(key, f old_value new_value)''
addToFM_C :: (Ord key) => (elt -> elt -> elt)
-> FiniteMap key elt -> key -> elt
-> FiniteMap key elt
-- | Combines added item with previous item, if any, items are added left-to-right
addListToFM_C :: (Ord key) => (elt -> elt -> elt)
-> FiniteMap key elt -> [(key,elt)]
-> FiniteMap key elt
-- | Deletion doesn't complain if you try to delete something which isn't there
delFromFM :: (Ord key)
=> FiniteMap key elt -> key -> FiniteMap key elt
-- | Deletion doesn't complain if you try to delete something which isn't there
delListFromFM :: (Ord key)
=> FiniteMap key elt -> [key] -> FiniteMap key elt
-- COMBINING
-- | Bindings in right argument shadow those in the left
plusFM :: (Ord key)
=> FiniteMap key elt -> FiniteMap key elt -> FiniteMap key elt
-- | Combines bindings for the same thing with the given function,
-- bindings in right argument shadow those in the left
plusFM_C :: (Ord key)
=> (elt -> elt -> elt)
-> FiniteMap key elt -> FiniteMap key elt -> FiniteMap key elt
-- | Deletes from the left argument any bindings in the right argument
minusFM :: (Ord key)
=> FiniteMap key elt -> FiniteMap key elt -> FiniteMap key elt
intersectFM :: (Ord key)
=> FiniteMap key elt -> FiniteMap key elt -> FiniteMap key elt
-- | Combines bindings for the same thing in the two maps with the given function
intersectFM_C :: (Ord key)
=> (elt1 -> elt2 -> elt3)
-> FiniteMap key elt1 -> FiniteMap key elt2
-> FiniteMap key elt3
-- MAPPING, FOLDING, FILTERING
foldFM :: (key -> elt -> a -> a) -> a -> FiniteMap key elt -> a
mapFM :: (key -> elt1 -> elt2)
-> FiniteMap key elt1 -> FiniteMap key elt2
filterFM :: (Ord key)
=> (key -> elt -> Bool)
-> FiniteMap key elt -> FiniteMap key elt
-- INTERROGATING
sizeFM :: FiniteMap key elt -> Int
isEmptyFM :: FiniteMap key elt -> Bool
elemFM :: (Ord key)
=> key -> FiniteMap key elt -> Bool
lookupFM :: (Ord key)
=> FiniteMap key elt -> key -> Maybe elt
-- | Supplies a "default" element in return for an unmapped key
lookupWithDefaultFM :: (Ord key)
=> FiniteMap key elt -> elt -> key -> elt
-- LISTIFYING
fmToList :: FiniteMap key elt -> [(key,elt)]
keysFM :: FiniteMap key elt -> [key]
eltsFM :: FiniteMap key elt -> [elt]
\end{code}
%************************************************************************
%* *
\subsection{Implementation using ``Data.Map''}
%* *
%************************************************************************
\begin{code}
newtype FiniteMap key elt = FM (M.Map key elt)
emptyFM = FM M.empty
unitFM k v = FM (M.singleton k v)
listToFM l = FM (M.fromList l)
addToFM (FM m) k v = FM (M.insert k v m)
-- Arguments of combining function of M.insertWith and addToFM_C are flipped.
addToFM_C f (FM m) k v = FM (M.insertWith (flip f) k v m)
addListToFM = foldl (\m (k, v) -> addToFM m k v)
addListToFM_C f = foldl (\m (k, v) -> addToFM_C f m k v)
delFromFM (FM m) k = FM (M.delete k m)
delListFromFM = foldl delFromFM
-- M.union is left-biased, plusFM should be right-biased.
plusFM (FM x) (FM y) = FM (M.union y x)
plusFM_C f (FM x) (FM y) = FM (M.unionWith f x y)
minusFM (FM x) (FM y) = FM (M.difference x y)
foldFM k z (FM m) = M.foldWithKey k z m
intersectFM (FM x) (FM y) = FM (M.intersection x y)
intersectFM_C f (FM x) (FM y) = FM (M.intersectionWith f x y)
mapFM f (FM m) = FM (M.mapWithKey f m)
filterFM p (FM m) = FM (M.filterWithKey p m)
sizeFM (FM m) = M.size m
isEmptyFM (FM m) = M.null m
elemFM k (FM m) = M.member k m
lookupFM (FM m) k = M.lookup k m
lookupWithDefaultFM (FM m) v k = M.findWithDefault v k m
fmToList (FM m) = M.toList m
keysFM (FM m) = M.keys m
eltsFM (FM m) = M.elems m
bagToFM = foldrBag (\(k,v) m -> addToFM m k v) emptyFM
\end{code}
%************************************************************************
%* *
\subsection{Output-ery}
%* *
%************************************************************************
\begin{code}
instance (Outputable key, Outputable elt) => Outputable (FiniteMap key elt) where
ppr fm = ppr (fmToList fm)
\end{code}
|
