[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