[commit: packages/containers] changelog-foldtree, cleaned_bugfix394, develop-0.6, develop-0.6-questionable, master, merge-doc-target, merge-fixes-5.9, merge-restrict-fix-5.8, revert-184-generic, revert-408-bugfix_394, zip-devel: Add Foldable.{elem, maximum, minimum, sum, product} specializations. (530fc76)
git at git.haskell.org
git at git.haskell.org
Mon Apr 17 21:34:29 UTC 2017
Repository : ssh://git@git.haskell.org/containers
On branches: changelog-foldtree,cleaned_bugfix394,develop-0.6,develop-0.6-questionable,master,merge-doc-target,merge-fixes-5.9,merge-restrict-fix-5.8,revert-184-generic,revert-408-bugfix_394,zip-devel
Link : http://git.haskell.org/packages/containers.git/commitdiff/530fc76bdd17089fcaaa655d66156abbc2092c2c
>---------------------------------------------------------------
commit 530fc76bdd17089fcaaa655d66156abbc2092c2c
Author: Milan Straka <fox at ucw.cz>
Date: Sun Oct 19 14:07:42 2014 +0200
Add Foldable.{elem,maximum,minimum,sum,product} specializations.
Following #56, add specializations for other base-4.8 Foldable methods,
using strict folds and shortcircuiting.
The Set.elem uses only Eq a, so it runs in linear time.
>---------------------------------------------------------------
530fc76bdd17089fcaaa655d66156abbc2092c2c
Data/IntMap/Base.hs | 30 ++++++++++++++++++++++++++++++
Data/Map/Base.hs | 25 +++++++++++++++++++++++++
Data/Set/Base.hs | 9 +++++++++
3 files changed, 64 insertions(+)
diff --git a/Data/IntMap/Base.hs b/Data/IntMap/Base.hs
index c1b2f4d..007e41e 100644
--- a/Data/IntMap/Base.hs
+++ b/Data/IntMap/Base.hs
@@ -341,6 +341,36 @@ instance Foldable.Foldable IntMap where
{-# INLINE null #-}
toList = elems -- NB: Foldable.toList /= IntMap.toList
{-# INLINE toList #-}
+ elem = go
+ where STRICT_1_OF_2(go)
+ go _ Nil = False
+ go x (Tip _ y) = x == y
+ go x (Bin _ _ l r) = go x l || go x r
+ {-# INLINABLE elem #-}
+ maximum = start
+ where start Nil = error "IntMap.Foldable.maximum: called with empty map"
+ start (Tip _ y) = y
+ start (Bin _ _ l r) = go (start l) r
+
+ STRICT_1_OF_2(go)
+ go m Nil = m
+ go m (Tip _ y) = max m y
+ go m (Bin _ _ l r) = go (go m l) r
+ {-# INLINABLE maximum #-}
+ minimum = start
+ where start Nil = error "IntMap.Foldable.minimum: called with empty map"
+ start (Tip _ y) = y
+ start (Bin _ _ l r) = go (start l) r
+
+ STRICT_1_OF_2(go)
+ go m Nil = m
+ go m (Tip _ y) = min m y
+ go m (Bin _ _ l r) = go (go m l) r
+ {-# INLINABLE minimum #-}
+ sum = foldl' (+) 0
+ {-# INLINABLE sum #-}
+ product = foldl' (*) 1
+ {-# INLINABLE product #-}
#endif
instance Traversable IntMap where
diff --git a/Data/Map/Base.hs b/Data/Map/Base.hs
index 781ac3a..de074f4 100644
--- a/Data/Map/Base.hs
+++ b/Data/Map/Base.hs
@@ -2675,6 +2675,31 @@ instance Foldable.Foldable (Map k) where
{-# INLINE null #-}
toList = elems -- NB: Foldable.toList /= Map.toList
{-# INLINE toList #-}
+ elem = go
+ where STRICT_1_OF_2(go)
+ go _ Tip = False
+ go x (Bin _ _ v l r) = x == v || go x l || go x r
+ {-# INLINABLE elem #-}
+ maximum = start
+ where start Tip = error "Map.Foldable.maximum: called with empty map"
+ start (Bin _ _ v l r) = go (go v l) r
+
+ STRICT_1_OF_2(go)
+ go m Tip = m
+ go m (Bin _ _ v l r) = go (go (max m v) l) r
+ {-# INLINABLE maximum #-}
+ minimum = start
+ where start Tip = error "Map.Foldable.minumum: called with empty map"
+ start (Bin _ _ v l r) = go (go v l) r
+
+ STRICT_1_OF_2(go)
+ go m Tip = m
+ go m (Bin _ _ v l r) = go (go (min m v) l) r
+ {-# INLINABLE minimum #-}
+ sum = foldl' (+) 0
+ {-# INLINABLE sum #-}
+ product = foldl' (*) 1
+ {-# INLINABLE product #-}
#endif
instance (NFData k, NFData a) => NFData (Map k a) where
diff --git a/Data/Set/Base.hs b/Data/Set/Base.hs
index 67ade4e..7e792f4 100644
--- a/Data/Set/Base.hs
+++ b/Data/Set/Base.hs
@@ -283,10 +283,19 @@ instance Foldable.Foldable Set where
{-# INLINE null #-}
toList = toList
{-# INLINE toList #-}
+ elem = go
+ where STRICT_1_OF_2(go)
+ go _ Tip = False
+ go x (Bin _ y l r) = x == y || go x l || go x r
+ {-# INLINABLE elem #-}
minimum = findMin
{-# INLINE minimum #-}
maximum = findMax
{-# INLINE maximum #-}
+ sum = foldl' (+) 0
+ {-# INLINABLE sum #-}
+ product = foldl' (*) 1
+ {-# INLINABLE product #-}
#endif
More information about the ghc-commits
mailing list