[commit: packages/containers] master: Defeat worker/wrapper in insertR too (#417) (3b7edae)

git at git.haskell.org git at git.haskell.org
Mon Apr 17 21:48:58 UTC 2017


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

On branch  : master
Link       : http://git.haskell.org/packages/containers.git/commitdiff/3b7edae004997234b433f0986d1180f7401e3d98

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

commit 3b7edae004997234b433f0986d1180f7401e3d98
Author: David Feuer <David.Feuer at gmail.com>
Date:   Fri Feb 24 12:51:11 2017 -0500

    Defeat worker/wrapper in insertR too (#417)


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

3b7edae004997234b433f0986d1180f7401e3d98
 Data/Map/Internal.hs | 13 +++++++------
 Data/Set/Internal.hs | 13 +++++++------
 2 files changed, 14 insertions(+), 12 deletions(-)

diff --git a/Data/Map/Internal.hs b/Data/Map/Internal.hs
index 55f8544..aa1bfcb 100644
--- a/Data/Map/Internal.hs
+++ b/Data/Map/Internal.hs
@@ -804,19 +804,20 @@ lazy a = a
 -- Used by `union`.
 
 -- See Note: Type of local 'go' function
+-- See Note: Avoiding worker/wrapper
 insertR :: Ord k => k -> a -> Map k a -> Map k a
-insertR = go
+insertR kx0 = go kx0 kx0
   where
-    go :: Ord k => k -> a -> Map k a -> Map k a
-    go !kx x Tip = singleton kx x
-    go kx x t@(Bin _ ky y l r) =
+    go :: Ord k => k -> k -> a -> Map k a -> Map k a
+    go orig !kx x Tip = singleton (lazy orig) x
+    go orig !kx x t@(Bin sz ky y l r) =
         case compare kx ky of
             LT | l' `ptrEq` l -> t
                | otherwise -> balanceL ky y l' r
-               where !l' = go kx x l
+               where !l' = go orig kx x l
             GT | r' `ptrEq` r -> t
                | otherwise -> balanceR ky y l r'
-               where !r' = go kx x r
+               where !r' = go orig kx x r
             EQ -> t
 #if __GLASGOW_HASKELL__
 {-# INLINABLE insertR #-}
diff --git a/Data/Set/Internal.hs b/Data/Set/Internal.hs
index d0d4394..3fc47ef 100644
--- a/Data/Set/Internal.hs
+++ b/Data/Set/Internal.hs
@@ -535,18 +535,19 @@ lazy a = a
 -- Used by `union`.
 
 -- See Note: Type of local 'go' function
+-- See Note: Avoiding worker/wrapper (in Data.Map.Internal)
 insertR :: Ord a => a -> Set a -> Set a
-insertR = go
+insertR x0 = go x0 x0
   where
-    go :: Ord a => a -> Set a -> Set a
-    go !x Tip = singleton x
-    go !x t@(Bin _ y l r) = case compare x y of
+    go :: Ord a => a -> a -> Set a -> Set a
+    go orig !x Tip = singleton (lazy orig)
+    go orig !x t@(Bin sz y l r) = case compare x y of
         LT | l' `ptrEq` l -> t
            | otherwise -> balanceL y l' r
-           where !l' = go x l
+           where !l' = go orig x l
         GT | r' `ptrEq` r -> t
            | otherwise -> balanceR y l r'
-           where !r' = go x r
+           where !r' = go orig x r
         EQ -> t
 #if __GLASGOW_HASKELL__
 {-# INLINABLE insertR #-}



More information about the ghc-commits mailing list