Defeat worker/wrapper in insertR too (#417)
authorDavid Feuer <David.Feuer@gmail.com>
Fri, 24 Feb 2017 17:51:11 +0000 (12:51 -0500)
committerGitHub <noreply@github.com>
Fri, 24 Feb 2017 17:51:11 +0000 (12:51 -0500)
Data/Map/Internal.hs
Data/Set/Internal.hs

index 55f8544..aa1bfcb 100644 (file)
@@ -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 #-}
index d0d4394..3fc47ef 100644 (file)
@@ -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 #-}