Repository : ssh://darcs.haskell.org//srv/darcs/packages/containers On branch : master
http://hackage.haskell.org/trac/ghc/changeset/c5e7ea333a0505f1bdf1580d593d6423edb0ee62 >--------------------------------------------------------------- commit c5e7ea333a0505f1bdf1580d593d6423edb0ee62 Author: Johan Tibell <[email protected]> Date: Mon Nov 21 08:38:43 2011 -0800 Use strictPair everywhere >--------------------------------------------------------------- Data/IntMap/Strict.hs | 11 +---------- Data/Map/Strict.hs | 29 ++++++++++------------------- Data/Pair.hs | 6 ++++++ containers.cabal | 1 + 4 files changed, 18 insertions(+), 29 deletions(-) diff --git a/Data/IntMap/Strict.hs b/Data/IntMap/Strict.hs index 855544d..b286e3b 100644 --- a/Data/IntMap/Strict.hs +++ b/Data/IntMap/Strict.hs @@ -226,7 +226,7 @@ import Data.IntMap.Lazy hiding , fromAscListWithKey , fromDistinctAscList ) - +import Data.Pair {-------------------------------------------------------------------- Construction @@ -875,12 +875,3 @@ fromDistinctAscList (z0 : zs0) = work z0 zs0 Nada p = mask px m data Stack a = Push {-# UNPACK #-} !Prefix !(IntMap a) !(Stack a) | Nada - - -{-------------------------------------------------------------------- - Utility ---------------------------------------------------------------------} - -strictPair :: a -> b -> (a, b) -strictPair x y = x `seq` y `seq` (x, y) -{-# INLINE strictPair #-} diff --git a/Data/Map/Strict.hs b/Data/Map/Strict.hs index ba95cfe..2c1c218 100644 --- a/Data/Map/Strict.hs +++ b/Data/Map/Strict.hs @@ -264,6 +264,7 @@ import Data.Map.Base hiding , updateMinWithKey , updateMaxWithKey ) +import Data.Pair -- Use macros to define strictness of functions. STRICT_x_OF_y -- denotes an y-ary function strict in the x-th parameter. Similarly @@ -419,18 +420,15 @@ insertLookupWithKey :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a insertLookupWithKey = go where STRICT_2_3_OF_4(go) - go _ kx x Tip = (Nothing, singleton kx x) + go _ kx x Tip = Nothing `strictPair` singleton kx x go f kx x (Bin sy ky y l r) = case compare kx ky of LT -> let (found, l') = go f kx x l - t = balanceL ky y l' r - in t `seq` (found, t) + in found `strictPair` balanceL ky y l' r GT -> let (found, r') = go f kx x r - t = balanceR ky y l r' - in t `seq` (found, t) + in found `strictPair` balanceR ky y l r' EQ -> let x' = f kx x y - t = Bin sy kx x' l r - in x' `seq` t `seq` (Just y, t) + in x' `seq` (Just y `strictPair` Bin sy kx x' l r) #if __GLASGOW_HASKELL__ >= 700 {-# INLINEABLE insertLookupWithKey #-} #else @@ -524,14 +522,11 @@ updateLookupWithKey = go go f k (Bin sx kx x l r) = case compare k kx of LT -> let (found,l') = go f k l - t = balanceR kx x l' r - in t `seq` (found,t) + in found `strictPair` balanceR kx x l' r GT -> let (found,r') = go f k r - t = balanceL kx x l r' - in t `seq` (found,t) + in found `strictPair` balanceL kx x l r' EQ -> case f kx x of - Just x' -> let t = Bin sx kx x' l r - in x' `seq` t `seq` (Just x',t) + Just x' -> x' `seq` (Just x' `strictPair` Bin sx kx x' l r) Nothing -> (Just x,glue l r) #if __GLASGOW_HASKELL__ >= 700 {-# INLINEABLE updateLookupWithKey #-} @@ -892,12 +887,8 @@ mapEitherWithKey :: Ord k => (k -> a -> Either b c) -> Map k a -> (Map k b, Map k c) mapEitherWithKey _ Tip = (Tip, Tip) mapEitherWithKey f (Bin _ kx x l r) = case f kx x of - Left y -> let l' = join kx y l1 r1 - r' = merge l2 r2 - in y `seq` l' `seq` r' `seq` (l', r') - Right z -> let l' = merge l1 r1 - r' = join kx z l2 r2 - in z `seq` l' `seq` r' `seq` (l', r') + Left y -> y `seq` (join kx y l1 r1 `strictPair` merge l2 r2) + Right z -> z `seq` (merge l1 r1 `strictPair` join kx z l2 r2) where (l1,l2) = mapEitherWithKey f l (r1,r2) = mapEitherWithKey f r diff --git a/Data/Pair.hs b/Data/Pair.hs new file mode 100644 index 0000000..40c84ef --- /dev/null +++ b/Data/Pair.hs @@ -0,0 +1,6 @@ +module Data.Pair (strictPair) where + +-- | Evaluate both argument to WHNF and create a pair of the result. +strictPair :: a -> b -> (a, b) +strictPair x y = x `seq` y `seq` (x, y) +{-# INLINE strictPair #-} diff --git a/containers.cabal b/containers.cabal index 2ff8a37..ea3a037 100644 --- a/containers.cabal +++ b/containers.cabal @@ -33,6 +33,7 @@ Library other-modules: Data.IntMap.Base Data.Map.Base + Data.Pair exposed-modules: Data.IntMap Data.IntMap.Lazy _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
