2 % (c) The University of Glasgow 2006
3 % (c) The AQUA Project, Glasgow University, 1994-1998
6 ``Finite maps'' are the heart of the compiler's lookup-tables/environments
7 and its implementation of sets. Important stuff!
9 The implementation uses @Data.Map@ from the containers package, which
10 is both maintained and faster than the past implementation (see commit log).
12 The orinigal interface is being kept around. It maps directly to Data.Map,
13 only ``Data.Map.union'' is left-biased and ``plusFM'' right-biased and
14 ``addToFM\_C'' and ``Data.Map.insertWith'' differ in the order of
15 arguments of combining function.
19 -- * Mappings keyed from arbitrary types
20 FiniteMap, -- abstract data type
22 -- ** Manipulating those mappings
23 emptyFM, unitFM, listToFM,
41 sizeFM, isEmptyFM, elemFM, lookupFM, lookupWithDefaultFM,
43 fmToList, keysFM, eltsFM,
48 import Bag ( Bag, foldrBag )
51 import qualified Data.Map as M
56 %************************************************************************
58 \subsection{The signature of the module}
60 %************************************************************************
64 emptyFM :: FiniteMap key elt
65 unitFM :: key -> elt -> FiniteMap key elt
66 -- | In the case of duplicates keys, the last item is taken
67 listToFM :: (Ord key) => [(key,elt)] -> FiniteMap key elt
68 -- | In the case of duplicate keys, who knows which item is taken
69 bagToFM :: (Ord key) => Bag (key,elt) -> FiniteMap key elt
71 -- ADDING AND DELETING
73 -- | Throws away any previous binding
75 => FiniteMap key elt -> key -> elt -> FiniteMap key elt
76 -- | Throws away any previous binding, items are added left-to-right
77 addListToFM :: (Ord key)
78 => FiniteMap key elt -> [(key,elt)] -> FiniteMap key elt
80 -- | Combines added item with previous item, if any --
81 -- if the key is present, ``addToFM_C f`` inserts
82 -- ``(key, f old_value new_value)''
83 addToFM_C :: (Ord key) => (elt -> elt -> elt)
84 -> FiniteMap key elt -> key -> elt
86 -- | Combines added item with previous item, if any, items are added left-to-right
87 addListToFM_C :: (Ord key) => (elt -> elt -> elt)
88 -> FiniteMap key elt -> [(key,elt)]
91 -- | Deletion doesn't complain if you try to delete something which isn't there
92 delFromFM :: (Ord key)
93 => FiniteMap key elt -> key -> FiniteMap key elt
94 -- | Deletion doesn't complain if you try to delete something which isn't there
95 delListFromFM :: (Ord key)
96 => FiniteMap key elt -> [key] -> FiniteMap key elt
100 -- | Bindings in right argument shadow those in the left
102 => FiniteMap key elt -> FiniteMap key elt -> FiniteMap key elt
104 -- | Combines bindings for the same thing with the given function,
105 -- bindings in right argument shadow those in the left
106 plusFM_C :: (Ord key)
107 => (elt -> elt -> elt)
108 -> FiniteMap key elt -> FiniteMap key elt -> FiniteMap key elt
110 -- | Deletes from the left argument any bindings in the right argument
112 => FiniteMap key elt -> FiniteMap key elt -> FiniteMap key elt
114 intersectFM :: (Ord key)
115 => FiniteMap key elt -> FiniteMap key elt -> FiniteMap key elt
116 -- | Combines bindings for the same thing in the two maps with the given function
117 intersectFM_C :: (Ord key)
118 => (elt1 -> elt2 -> elt3)
119 -> FiniteMap key elt1 -> FiniteMap key elt2
120 -> FiniteMap key elt3
122 -- MAPPING, FOLDING, FILTERING
123 foldFM :: (key -> elt -> a -> a) -> a -> FiniteMap key elt -> a
124 mapFM :: (key -> elt1 -> elt2)
125 -> FiniteMap key elt1 -> FiniteMap key elt2
126 filterFM :: (Ord key)
127 => (key -> elt -> Bool)
128 -> FiniteMap key elt -> FiniteMap key elt
131 sizeFM :: FiniteMap key elt -> Int
132 isEmptyFM :: FiniteMap key elt -> Bool
135 => key -> FiniteMap key elt -> Bool
136 lookupFM :: (Ord key)
137 => FiniteMap key elt -> key -> Maybe elt
138 -- | Supplies a "default" element in return for an unmapped key
139 lookupWithDefaultFM :: (Ord key)
140 => FiniteMap key elt -> elt -> key -> elt
143 fmToList :: FiniteMap key elt -> [(key,elt)]
144 keysFM :: FiniteMap key elt -> [key]
145 eltsFM :: FiniteMap key elt -> [elt]
148 %************************************************************************
150 \subsection{Implementation using ``Data.Map''}
152 %************************************************************************
155 newtype FiniteMap key elt = FM (M.Map key elt)
158 unitFM k v = FM (M.singleton k v)
159 listToFM l = FM (M.fromList l)
161 addToFM (FM m) k v = FM (M.insert k v m)
162 -- Arguments of combining function of M.insertWith and addToFM_C are flipped.
163 addToFM_C f (FM m) k v = FM (M.insertWith (flip f) k v m)
164 addListToFM = foldl (\m (k, v) -> addToFM m k v)
165 addListToFM_C f = foldl (\m (k, v) -> addToFM_C f m k v)
166 delFromFM (FM m) k = FM (M.delete k m)
167 delListFromFM = foldl delFromFM
169 -- M.union is left-biased, plusFM should be right-biased.
170 plusFM (FM x) (FM y) = FM (M.union y x)
171 plusFM_C f (FM x) (FM y) = FM (M.unionWith f x y)
172 minusFM (FM x) (FM y) = FM (M.difference x y)
173 foldFM k z (FM m) = M.foldWithKey k z m
175 intersectFM (FM x) (FM y) = FM (M.intersection x y)
176 intersectFM_C f (FM x) (FM y) = FM (M.intersectionWith f x y)
177 mapFM f (FM m) = FM (M.mapWithKey f m)
178 filterFM p (FM m) = FM (M.filterWithKey p m)
180 sizeFM (FM m) = M.size m
181 isEmptyFM (FM m) = M.null m
182 elemFM k (FM m) = M.member k m
183 lookupFM (FM m) k = M.lookup k m
184 lookupWithDefaultFM (FM m) v k = M.findWithDefault v k m
186 fmToList (FM m) = M.toList m
187 keysFM (FM m) = M.keys m
188 eltsFM (FM m) = M.elems m
190 bagToFM = foldrBag (\(k,v) m -> addToFM m k v) emptyFM
194 %************************************************************************
196 \subsection{Output-ery}
198 %************************************************************************
201 instance (Outputable key, Outputable elt) => Outputable (FiniteMap key elt) where
202 ppr fm = ppr (fmToList fm)