[commit: packages/containers] cleaned_bugfix394, master, merge-doc-target, merge-fixes-5.9, merge-restrict-fix-5.8, revert-408-bugfix_394: Fix strictness of alterF rewrite target (05c65b9)

git at git.haskell.org git at git.haskell.org
Mon Apr 17 21:41:55 UTC 2017


Repository : ssh://git@git.haskell.org/containers

On branches: cleaned_bugfix394,master,merge-doc-target,merge-fixes-5.9,merge-restrict-fix-5.8,revert-408-bugfix_394
Link       : http://git.haskell.org/packages/containers.git/commitdiff/05c65b90d7444c2bd3f1a83775a10684131a9681

>---------------------------------------------------------------

commit 05c65b90d7444c2bd3f1a83775a10684131a9681
Author: David Feuer <David.Feuer at gmail.com>
Date:   Sun May 22 21:10:38 2016 -0400

    Fix strictness of alterF rewrite target
    
    The strict `alterF` rewrite target for `(,) b` was too strict.
    I *think* it now has the correct semantics.


>---------------------------------------------------------------

05c65b90d7444c2bd3f1a83775a10684131a9681
 Data/Map/Base.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/Data/Map/Base.hs b/Data/Map/Base.hs
index 2e0bead..8fb7f11 100644
--- a/Data/Map/Base.hs
+++ b/Data/Map/Base.hs
@@ -1219,7 +1219,7 @@ atKeyWithLookup strict k0 f0 t = case go k0 f0 t of
                    (b, Nothing) -> AltSameLook b
                    (b, Just x)  -> case strict of
                      Lazy -> AltBiggerLook b (singleton k x)
-                     Strict -> x `seq` (AltBiggerLook b $ singleton k x)
+                     Strict -> (AltBiggerLook b $ singleton k $! x)
 
     go k f (Bin sx kx x l r) = case compare k kx of
                    LT -> case go k f l of
@@ -1235,7 +1235,7 @@ atKeyWithLookup strict k0 f0 t = case go k0 f0 t of
                    EQ -> case f (Just x) of
                            (b, Just x') -> case strict of
                              Lazy -> AltAdjLook b $ Bin sx kx x' l r
-                             Strict -> x' `seq` (AltAdjLook b $ Bin sx kx x' l r)
+                             Strict -> AltAdjLook b (x' `seq` Bin sx kx x' l r)
                            (b, Nothing) -> AltSmallerLook b $ glue l r
 {-# INLINE atKeyWithLookup #-}
 



More information about the ghc-commits mailing list