[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