X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Data%2FFiniteMap.hs;h=8bafafce1d349c15afb854c48962c4d888691a00;hb=5031aad924a8b70b5fc4fe4bb1321c007afcab21;hp=96a9faf82955783c83267fd7479fe037bace489e;hpb=27e10d6cb4ae6798ad78662db809f675ba0e1208;p=ghc-base.git diff --git a/Data/FiniteMap.hs b/Data/FiniteMap.hs index 96a9faf..8bafafc 100644 --- a/Data/FiniteMap.hs +++ b/Data/FiniteMap.hs @@ -8,6 +8,8 @@ -- Stability : provisional -- Portability : portable -- +-- NOTE: Data.FiniteMap is DEPRECATED, please use "Data.Map" instead. +-- -- A finite map implementation, derived from the paper: -- /Efficient sets: a balancing act/, S. Adams, -- Journal of functional programming 3(4) Oct 1993, pp553-562 @@ -38,7 +40,9 @@ #define OUTPUTABLE_key {--} #endif -module Data.FiniteMap ( +module Data.FiniteMap + {-# DEPRECATED "Please use Data.Map instead." #-} + ( -- * The @FiniteMap@ type FiniteMap, -- abstract type @@ -74,14 +78,28 @@ module Data.FiniteMap ( IF_NOT_GHC(intersectFM_C COMMA) IF_NOT_GHC(mapFM COMMA filterFM COMMA) + foldFM_GE, fmToList_GE, keysFM_GE, eltsFM_GE, + foldFM_LE, fmToList_LE, keysFM_LE, eltsFM_LE, + + minFM, maxFM, + #ifdef COMPILING_GHC , bagToFM #endif ) where +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 @@ -106,6 +124,7 @@ import Bag ( foldBag ) #endif /* not GHC */ + -- --------------------------------------------------------------------------- -- The signature of the module @@ -171,14 +190,14 @@ plusFM_C :: (Ord key OUTPUTABLE_key) => (elt -> elt -> elt) -> FiniteMap key elt -> FiniteMap key elt -> FiniteMap key elt -- | @(minusFM a1 a2)@ deletes from @a1@ any mappings which are bound in @a2@ -minusFM :: (Ord key OUTPUTABLE_key) => FiniteMap key elt -> FiniteMap key elt -> FiniteMap key elt +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 interesction of two mappings, using the specified +-- | 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 @@ -268,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@ @@ -430,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@: