[commit: packages/containers] cleaned_bugfix394, master, merge-doc-target, merge-fixes-5.9, merge-restrict-fix-5.8, revert-408-bugfix_394: Remove a bunch of unnecessary laziness (164ea00)
git at git.haskell.org
git at git.haskell.org
Mon Apr 17 21:41:00 UTC 2017
- Previous message: [commit: packages/containers] cleaned_bugfix394, master, merge-doc-target, merge-fixes-5.9, merge-restrict-fix-5.8, revert-408-bugfix_394: Merge pull request #235 from haskell/changelog-foldtree (56f290c)
- Next message: [commit: packages/containers] cleaned_bugfix394, master, merge-doc-target, merge-fixes-5.9, merge-restrict-fix-5.8, revert-408-bugfix_394: Merge pull request #223 from treeowl/strictify-pairs (1c92e2e)
- Messages sorted by:
[ date ]
[ thread ]
[ subject ]
[ author ]
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/164ea0054e9ada397f698b782fd9084a93e5a4f9
>---------------------------------------------------------------
commit 164ea0054e9ada397f698b782fd9084a93e5a4f9
Author: David Feuer <David.Feuer at gmail.com>
Date: Thu May 12 18:20:18 2016 -0400
Remove a bunch of unnecessary laziness
Lots of functions in `Data.Map.Base` used lazy pairs and such for no
obviously good reason. As a result, they sometimes did strange things
like building up chains of suspensions to rebuild trees.
>---------------------------------------------------------------
164ea0054e9ada397f698b782fd9084a93e5a4f9
Data/Map/Base.hs | 42 +++++++++++++++++++++++++++---------------
changelog.md | 2 ++
2 files changed, 29 insertions(+), 15 deletions(-)
diff --git a/Data/Map/Base.hs b/Data/Map/Base.hs
index fb4b08d..92ecda0 100644
--- a/Data/Map/Base.hs
+++ b/Data/Map/Base.hs
@@ -772,10 +772,12 @@ insertLookupWithKey = go
go _ !kx x Tip = (Nothing, 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
- in (found, balanceL ky y l' r)
- GT -> let (found, r') = go f kx x r
- in (found, balanceR ky y l r')
+ LT -> let !(found, l') = go f kx x l
+ !t' = balanceL ky y l' r
+ in (found, t')
+ GT -> let !(found, r') = go f kx x r
+ !t' = balanceR ky y l r'
+ in (found, t')
EQ -> (Just y, Bin sy kx (f kx x y) l r)
#if __GLASGOW_HASKELL__
{-# INLINABLE insertLookupWithKey #-}
@@ -913,11 +915,16 @@ updateLookupWithKey = go
go _ !_ Tip = (Nothing,Tip)
go f k (Bin sx kx x l r) =
case compare k kx of
- LT -> let (found,l') = go f k l in (found,balanceR kx x l' r)
- GT -> let (found,r') = go f k r in (found,balanceL kx x l r')
+ LT -> let !(found,l') = go f k l
+ !t' = balanceR kx x l' r
+ in (found, t')
+ GT -> let !(found,r') = go f k r
+ !t' = balanceL kx x l r'
+ in (found, t')
EQ -> case f kx x of
- Just x' -> (Just x',Bin sx kx x' l r)
- Nothing -> (Just x,glue l r)
+ Just x' -> (Just x', Bin sx kx x' l r)
+ Nothing -> let !glued = glue l r
+ in (Just x, glued)
#if __GLASGOW_HASKELL__
{-# INLINABLE updateLookupWithKey #-}
#else
@@ -1429,7 +1436,7 @@ updateMaxWithKey f (Bin _ kx x l r) = balanceL kx x l (updateMaxWithKey f r)
minViewWithKey :: Map k a -> Maybe ((k,a), Map k a)
minViewWithKey Tip = Nothing
-minViewWithKey x = Just (deleteFindMin x)
+minViewWithKey x = Just $! deleteFindMin x
-- | /O(log n)/. Retrieves the maximal (key,value) pair of the map, and
-- the map stripped of that element, or 'Nothing' if passed an empty map.
@@ -1439,7 +1446,7 @@ minViewWithKey x = Just (deleteFindMin x)
maxViewWithKey :: Map k a -> Maybe ((k,a), Map k a)
maxViewWithKey Tip = Nothing
-maxViewWithKey x = Just (deleteFindMax x)
+maxViewWithKey x = Just $! deleteFindMax x
-- | /O(log n)/. Retrieves the value associated with minimal key of the
-- map, and the map stripped of that element, or 'Nothing' if passed an
@@ -1450,7 +1457,7 @@ maxViewWithKey x = Just (deleteFindMax x)
minView :: Map k a -> Maybe (a, Map k a)
minView Tip = Nothing
-minView x = Just (first snd $ deleteFindMin x)
+minView x = Just $! (first snd $ deleteFindMin x)
-- | /O(log n)/. Retrieves the value associated with maximal key of the
-- map, and the map stripped of that element, or 'Nothing' if passed an
@@ -1461,9 +1468,10 @@ minView x = Just (first snd $ deleteFindMin x)
maxView :: Map k a -> Maybe (a, Map k a)
maxView Tip = Nothing
-maxView x = Just (first snd $ deleteFindMax x)
+maxView x = Just $! (first snd $ deleteFindMax x)
--- Update the 1st component of a tuple (special case of Control.Arrow.first)
+-- Update the 1st component of a tuple (stricter version of
+-- Control.Arrow.first)
first :: (a -> b) -> (a,c) -> (b,c)
first f (x,y) = (f x, y)
@@ -2724,7 +2732,9 @@ deleteFindMin :: Map k a -> ((k,a),Map k a)
deleteFindMin t
= case t of
Bin _ k x Tip r -> ((k,x),r)
- Bin _ k x l r -> let (km,l') = deleteFindMin l in (km,balanceR k x l' r)
+ Bin _ k x l r -> let !(km,l') = deleteFindMin l
+ !t' = balanceR k x l' r
+ in (km, t')
Tip -> (error "Map.deleteFindMin: can not return the minimal element of an empty map", Tip)
-- | /O(log n)/. Delete and find the maximal element.
@@ -2736,7 +2746,9 @@ deleteFindMax :: Map k a -> ((k,a),Map k a)
deleteFindMax t
= case t of
Bin _ k x l Tip -> ((k,x),l)
- Bin _ k x l r -> let (km,r') = deleteFindMax r in (km,balanceL k x l r')
+ Bin _ k x l r -> let !(km,r') = deleteFindMax r
+ !t' = balanceL k x l r'
+ in (km, t')
Tip -> (error "Map.deleteFindMax: can not return the maximal element of an empty map", Tip)
diff --git a/changelog.md b/changelog.md
index 9e83fee..01e7f79 100644
--- a/changelog.md
+++ b/changelog.md
@@ -22,6 +22,8 @@
* Speed up `adjust` for `Data.Map`.
+ * Remove non-essential laziness in `Data.Map.Lazy` implementation.
+
* Speed up deletion and alteration functions for `Data.IntMap`.
## 0.5.7.1 *Dec 2015*
- Previous message: [commit: packages/containers] cleaned_bugfix394, master, merge-doc-target, merge-fixes-5.9, merge-restrict-fix-5.8, revert-408-bugfix_394: Merge pull request #235 from haskell/changelog-foldtree (56f290c)
- Next message: [commit: packages/containers] cleaned_bugfix394, master, merge-doc-target, merge-fixes-5.9, merge-restrict-fix-5.8, revert-408-bugfix_394: Merge pull request #223 from treeowl/strictify-pairs (1c92e2e)
- Messages sorted by:
[ date ]
[ thread ]
[ subject ]
[ author ]
More information about the ghc-commits
mailing list