X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Data%2FFiniteMap.hs;h=8bafafce1d349c15afb854c48962c4d888691a00;hb=ad2464d7646b2b0745615f4a23967444e23fea40;hp=025fcef9e06fbd30f2581b8862f11697a399ed1a;hpb=86c2560a1dce68cd2652a04c0489c80f7c6c2af5;p=ghc-base.git

diff --git a/Data/FiniteMap.hs b/Data/FiniteMap.hs
index 025fcef..8bafafc 100644
--- a/Data/FiniteMap.hs
+++ b/Data/FiniteMap.hs
@@ -1,23 +1,23 @@
 -----------------------------------------------------------------------------
--- 
+-- |
 -- Module      :  Data.FiniteMap
 -- Copyright   :  (c) The University of Glasgow 2001
--- License     :  BSD-style (see the file libraries/core/LICENSE)
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
 -- 
 -- Maintainer  :  libraries@haskell.org
 -- Stability   :  provisional
 -- Portability :  portable
 --
--- $Id: FiniteMap.hs,v 1.1 2001/08/17 12:44:54 simonmar Exp $
+-- NOTE: Data.FiniteMap is DEPRECATED, please use "Data.Map" instead.
 --
 -- A finite map implementation, derived from the paper:
--- 	   S Adams, "Efficient sets: a balancing act"
+-- 	   /Efficient sets: a balancing act/, S. Adams,
 -- 	   Journal of functional programming 3(4) Oct 1993, pp553-562
 --
--- ToDo: clean up, remove the COMPILING_GHC stuff.
---
 -----------------------------------------------------------------------------
 
+-- ToDo: clean up, remove the COMPILING_GHC stuff.
+
 -- The code is SPECIALIZEd to various highly-desirable types (e.g., Id)
 -- near the end (only \tr{#ifdef COMPILING_GHC}).
 
@@ -40,41 +40,66 @@
 #define OUTPUTABLE_key {--}
 #endif
 
-module Data.FiniteMap (
+module Data.FiniteMap
+  {-# DEPRECATED "Please use Data.Map instead." #-} 
+  (
+	-- * The @FiniteMap@ type
 	FiniteMap,		-- abstract type
 
+	-- * Construction
 	emptyFM, unitFM, listToFM,
 
+	-- * Lookup operations
+	lookupFM, lookupWithDefaultFM,
+	elemFM,
+
+	-- * Adding elements
 	addToFM,
 	addToFM_C,
 	addListToFM,
 	addListToFM_C,
+
+	-- * Deleting elements
 	IF_NOT_GHC(delFromFM COMMA)
 	delListFromFM,
 
+	-- * Combination
 	plusFM,
 	plusFM_C,
+
+	-- * Extracting information
+	fmToList, keysFM, eltsFM,
+	sizeFM, isEmptyFM,
+
+	-- * Other operations
 	minusFM,
 	foldFM,
-
 	IF_NOT_GHC(intersectFM COMMA)
 	IF_NOT_GHC(intersectFM_C COMMA)
 	IF_NOT_GHC(mapFM COMMA filterFM COMMA)
 
-	sizeFM, isEmptyFM, elemFM, lookupFM, lookupWithDefaultFM,
+	foldFM_GE, fmToList_GE, keysFM_GE, eltsFM_GE,
+	foldFM_LE, fmToList_LE, keysFM_LE, eltsFM_LE,
 
-	fmToList, keysFM, eltsFM
+        minFM, maxFM,
 
 #ifdef COMPILING_GHC
 	, bagToFM
 #endif
     ) where
 
-import Prelude
+import Prelude -- necessary to get dependencies right
 
 import Data.Maybe ( isJust )
 #ifdef __GLASGOW_HASKELL__
 import GHC.Base
+import Data.Typeable
+import Data.Generics.Basics
+import Data.Generics.Instances
+#endif
+
+#ifdef __HADDOCK__
+import Prelude
 #endif
 
 #ifdef COMPILING_GHC
@@ -99,54 +124,81 @@ import Bag	( foldBag )
 #endif /* not GHC */
 
 
+
 -- ---------------------------------------------------------------------------
 -- The signature of the module
 
---	BUILDING
+-- | An empty 'FiniteMap'.
 emptyFM		:: FiniteMap key elt
+
+-- | A 'FiniteMap' containing a single mapping
 unitFM		:: key -> elt -> FiniteMap key elt
+
+-- | Makes a 'FiniteMap' from a list of @(key,value)@ pairs. In the
+-- case of duplicates, the last is taken
 listToFM	:: (Ord key OUTPUTABLE_key) => [(key,elt)] -> FiniteMap key elt
-			-- In the case of duplicates, the last is taken
+
 #ifdef COMPILING_GHC
 bagToFM		:: (Ord key OUTPUTABLE_key) => Bag (key,elt) -> FiniteMap key elt
 			-- In the case of duplicates, who knows which is taken
 #endif
 
 --	ADDING AND DELETING
-		   -- Throws away any previous binding
-		   -- In the list case, the items are added starting with the
-		   -- first one in the list
+
+-- | Adds an element to a 'FiniteMap'.  Any previous mapping with the same
+-- key is overwritten.
 addToFM		:: (Ord key OUTPUTABLE_key) => FiniteMap key elt -> key -> elt  -> FiniteMap key elt
+
+-- | Adds a list of elements to a 'FiniteMap', in the order given in
+-- the list.  Overwrites previous mappings.
 addListToFM	:: (Ord key OUTPUTABLE_key) => FiniteMap key elt -> [(key,elt)] -> FiniteMap key elt
 
 		   -- Combines with previous binding
 		   -- In the combining function, the first argument is the "old" element,
 		   -- while the second is the "new" one.
+
+-- | Adds an element to a 'FiniteMap'.  If there is already an element
+-- with the same key, then the specified combination function is used
+-- to calculate the new value. The already present element is passed as
+-- the first argument and the new element to add as second.
 addToFM_C	:: (Ord key OUTPUTABLE_key) => (elt -> elt -> elt)
 			   -> FiniteMap key elt -> key -> elt
 			   -> FiniteMap key elt
+
+-- | A list version of 'addToFM_C'.  The elements are added in the
+-- order given in the list.
 addListToFM_C	:: (Ord key OUTPUTABLE_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
+-- | Deletes an element from a 'FiniteMap'.  If there is no element with
+-- the specified key, then the original 'FiniteMap' is returned.
 delFromFM	:: (Ord key OUTPUTABLE_key) => FiniteMap key elt -> key   -> FiniteMap key elt
+
+-- | List version of 'delFromFM'.
 delListFromFM	:: (Ord key OUTPUTABLE_key) => FiniteMap key elt -> [key] -> FiniteMap key elt
 
---	COMBINING
-		   -- Bindings in right argument shadow those in the left
+-- | Combine two 'FiniteMap's.  Mappings in the second argument shadow
+-- those in the first.
 plusFM		:: (Ord key OUTPUTABLE_key) => FiniteMap key elt -> FiniteMap key elt
 			   -> FiniteMap key elt
 
-		   -- Combines bindings for the same thing with the given function
+-- | Combine two 'FiniteMap's.  The specified combination function is
+-- used to calculate the new value when there are two elements with
+-- the same key.
 plusFM_C	:: (Ord key OUTPUTABLE_key) => (elt -> elt -> elt)
 			   -> FiniteMap key elt -> FiniteMap key elt -> FiniteMap key elt
 
-minusFM		:: (Ord key OUTPUTABLE_key) => FiniteMap key elt -> FiniteMap key elt -> FiniteMap key elt
-		   -- (minusFM a1 a2) deletes from a1 any bindings which are bound in a2
+-- | @(minusFM a1 a2)@ deletes from @a1@ any mappings which are bound in @a2@
+minusFM		:: (Ord key OUTPUTABLE_key) => FiniteMap key elt1 -> FiniteMap key elt2 -> FiniteMap key elt1
 
+-- | @(intersectFM a1 a2)@ returns a new 'FiniteMap' containing
+-- mappings from @a1@ for which @a2@ also has a mapping with the same
+-- key.
 intersectFM	:: (Ord key OUTPUTABLE_key) => FiniteMap key elt -> FiniteMap key elt -> FiniteMap key elt
+
+-- | Returns the intersection of two mappings, using the specified
+-- combination function to combine values.
 intersectFM_C	:: (Ord key OUTPUTABLE_key) => (elt1 -> elt2 -> elt3)
 			   -> FiniteMap key elt1 -> FiniteMap key elt2 -> FiniteMap key elt3
 
@@ -160,16 +212,37 @@ filterFM	:: (Ord key OUTPUTABLE_key) => (key -> elt -> Bool)
 sizeFM		:: FiniteMap key elt -> Int
 isEmptyFM	:: FiniteMap key elt -> Bool
 
+-- | Returns 'True' if the specified @key@ has a mapping in this
+-- 'FiniteMap', or 'False' otherwise.
 elemFM		:: (Ord key OUTPUTABLE_key) => key -> FiniteMap key elt -> Bool
+
+-- | Looks up a key in a 'FiniteMap', returning @'Just' v@ if the key
+-- was found with value @v@, or 'Nothing' otherwise.
 lookupFM	:: (Ord key OUTPUTABLE_key) => FiniteMap key elt -> key -> Maybe elt
+
+-- | Looks up a key in a 'FiniteMap', returning @elt@ if the specified
+-- @key@ was not found.
 lookupWithDefaultFM
 		:: (Ord key OUTPUTABLE_key) => FiniteMap key elt -> elt -> key -> elt
 		-- lookupWithDefaultFM supplies a "default" elt
 		-- to return for an unmapped key
 
 --	LISTIFYING
+
+-- | Convert a 'FiniteMap' to a @[(key, elt)]@ sorted by 'Ord' key
+--
 fmToList	:: FiniteMap key elt -> [(key,elt)]
+
+-- | Extract the keys from a 'FiniteMap', in the order of the keys, so
+--
+-- > keysFM == map fst . fmToList
+--
 keysFM		:: FiniteMap key elt -> [key]
+
+-- | Extract the elements from a 'FiniteMap', in the order of the keys, so
+--
+-- > eltsFM == map snd . fmToList
+--
 eltsFM		:: FiniteMap key elt -> [elt]
 
 -- ---------------------------------------------------------------------------
@@ -187,6 +260,7 @@ eltsFM		:: FiniteMap key elt -> [elt]
 -- * size of left subtree is differs from size of right subtree by a
 --   factor of at most \tr{sIZE_RATIO}
 
+-- | A mapping from @key@s to @elt@s.
 data FiniteMap key elt
   = EmptyFM
   | Branch key elt	    	-- Key and elt stored here
@@ -203,7 +277,7 @@ emptyFM
     bottom = panic "emptyFM"
 -}
 
--- #define EmptyFM (Branch _ _ IF_GHC(0#,0) _ _)
+--  #define EmptyFM (Branch _ _ IF_GHC(0#,0) _ _)
 
 unitFM key elt = Branch key elt IF_GHC(1#,1) emptyFM emptyFM
 
@@ -213,6 +287,28 @@ listToFM = addListToFM emptyFM
 bagToFM = foldBag plusFM (\ (k,v) -> unitFM k v) emptyFM
 #endif
 
+instance (Show k, Show e) => Show (FiniteMap k e) where
+  showsPrec p m = showsPrec p (fmToList m)
+
+instance Functor (FiniteMap k) where
+  fmap f = mapFM (const f)
+
+#if __GLASGOW_HASKELL__
+
+#include "Typeable.h"
+INSTANCE_TYPEABLE2(FiniteMap,arrayTc,"FiniteMap")
+
+-- This instance preserves data abstraction at the cost of inefficiency.
+-- We omit reflection services for the sake of data abstraction.
+
+instance (Data a, Data b, Ord a) => Data (FiniteMap a b) where
+  gfoldl f z fm = z listToFM `f` (fmToList fm)
+  toConstr _    = error "toConstr"
+  gunfold _ _   = error "gunfold"
+  dataTypeOf _  = mkNorepType "Data.FiniteMap.FiniteMap"
+
+#endif
+
 
 -- ---------------------------------------------------------------------------
 -- Adding to and deleting from @FiniteMaps@
@@ -375,6 +471,77 @@ eltsFM fm   = foldFM (\ key elt rest -> elt : rest)       [] fm
 
 
 -- ---------------------------------------------------------------------------
+-- Bulk operations on all keys >= or <=	a certain threshold
+
+-- | Fold through all elements greater than or equal to the supplied key,
+-- in increasing order.
+foldFM_GE       :: Ord key => (key -> elt -> a -> a) -> a -> key ->
+   FiniteMap key elt -> a
+
+foldFM_GE k z fr EmptyFM = z
+foldFM_GE k z fr (Branch key elt _ fm_l fm_r)
+  | key >= fr = foldFM_GE k (k key elt (foldFM_GE k z fr fm_r)) fr fm_l
+  | otherwise = foldFM_GE k z fr fm_r
+
+-- | List elements greater than or equal to the supplied key, in increasing
+-- order
+fmToList_GE      :: Ord key => FiniteMap key elt -> key ->  [(key,elt)]
+fmToList_GE fm fr = foldFM_GE (\ key elt rest -> (key,elt) : rest) [] fr fm
+
+-- | List keys greater than or equal to the supplied key, in increasing order
+keysFM_GE       :: Ord key => FiniteMap key elt -> key -> [key]
+keysFM_GE fm fr  = foldFM_GE (\ key elt rest -> key : rest)       [] fr fm
+
+-- | List elements corresponding to keys greater than or equal to the supplied
+-- key, in increasing order of key.
+eltsFM_GE       :: Ord key => FiniteMap key elt -> key -> [elt]
+eltsFM_GE fm fr  = foldFM_GE (\ key elt rest -> elt : rest)       [] fr fm
+
+-- | Fold through all elements less than or equal to the supplied key,
+-- in decreasing order.
+foldFM_LE       :: Ord key => (key -> elt -> a -> a) -> a -> key ->
+   FiniteMap key elt -> a
+foldFM_LE k z fr EmptyFM = z
+foldFM_LE k z fr (Branch key elt _ fm_l fm_r)
+  | key <= fr = foldFM_LE k (k key elt (foldFM_LE k z fr fm_l)) fr fm_r
+  | otherwise = foldFM_LE k z fr fm_l
+
+-- | List elements greater than or equal to the supplied key, in decreasing
+-- order
+fmToList_LE      :: Ord key => FiniteMap key elt -> key ->  [(key,elt)]
+fmToList_LE fm fr = foldFM_LE (\ key elt rest -> (key,elt) : rest) [] fr fm
+
+-- | List keys greater than or equal to the supplied key, in decreasing order
+keysFM_LE       :: Ord key => FiniteMap key elt -> key -> [key]
+keysFM_LE fm fr  = foldFM_LE (\ key elt rest -> key : rest)       [] fr fm
+
+-- | List elements corresponding to keys greater than or equal to the supplied
+-- key, in decreasing order of key.
+eltsFM_LE       :: Ord key => FiniteMap key elt -> key -> [elt]
+eltsFM_LE fm fr  = foldFM_LE (\ key elt rest -> elt : rest)       [] fr fm
+
+-- ---------------------------------------------------------------------------
+-- Getting minimum and maximum key out.
+-- ---------------------------------------------------------------------------
+
+-- | Extract minimum key, or Nothing if the map is empty.
+minFM :: Ord key => FiniteMap key elt -> Maybe key
+minFM EmptyFM = Nothing
+minFM (Branch key _ _ fm_l _) =
+   case minFM fm_l of
+      Nothing -> Just key
+      Just key1 -> Just key1
+
+-- | Extract maximum key, or Nothing if the map is empty.
+maxFM :: Ord key => FiniteMap key elt -> Maybe key
+maxFM EmptyFM = Nothing
+maxFM (Branch key _ _ _ fm_r) =
+   case maxFM fm_r of
+      Nothing -> Just key
+      Just key1 -> Just key1
+
+
+-- ---------------------------------------------------------------------------
 -- The implementation of balancing
 
 -- Basic construction of a @FiniteMap@:
@@ -732,4 +899,4 @@ instance (Ord key, Ord elt) => Ord (FiniteMap key elt) where
     IF_NCG(COMMA   (elt -> elt -> elt) -> FiniteMap Reg elt -> FiniteMap Reg elt -> FiniteMap Reg elt)
     #-}
 
-#endif {- compiling for GHC -}
+#endif /* compiling for GHC */