-%
-% (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
+ insertList,
+ insertListWith,
+ deleteList,
+ foldRight, foldRightWithKey
) 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
+import Data.Map (Map)
+import qualified Data.Map as Map
--- COMBINING
+insertList :: Ord key => [(key,elt)] -> Map key elt -> Map key elt
+insertList xs m = foldl (\m (k, v) -> Map.insert k v m) m xs
--- | Bindings in right argument shadow those in the left
-plusFM :: (Ord key)
- => FiniteMap key elt -> FiniteMap key elt -> FiniteMap key elt
+insertListWith :: Ord key
+ => (elt -> elt -> elt)
+ -> [(key,elt)]
+ -> Map key elt
+ -> Map key elt
+insertListWith f xs m0 = foldl (\m (k, v) -> Map.insertWith f k v m) m0 xs
--- | 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
+deleteList :: Ord key => [key] -> Map key elt -> Map key elt
+deleteList ks m = foldl (flip Map.delete) m ks
--- | 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)
-#if MIN_VERSION_containers(0,4,0)
-foldFM k z (FM m) = M.foldrWithKey k z m
+foldRight :: (elt -> a -> a) -> a -> Map key elt -> a
+foldRight = Map.fold
+foldRightWithKey :: (key -> elt -> a -> a) -> a -> Map key elt -> a
+#if (MIN_VERSION_containers(0,4,0))
+foldRightWithKey = Map.foldrWithKey
#else
-foldFM k z (FM m) = M.foldWithKey k z m
+foldRightWithKey = Map.foldWithKey
#endif
-
-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}
projects / ghc-hetmet.git / blobdiff