[commit: ghc] master: Extend `Foldable` class with `length` and `null` methods (e5cca4a)

git at git.haskell.org git at git.haskell.org
Sun Sep 28 13:07:39 UTC 2014 

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/e5cca4ab246ca2d1ecdd7c39eefd3157547cb6aa/ghc

>---------------------------------------------------------------

commit e5cca4ab246ca2d1ecdd7c39eefd3157547cb6aa
Author: Herbert Valerio Riedel <hvr at gnu.org>
Date:   Sun Sep 28 13:02:53 2014 +0200

    Extend `Foldable` class with `length` and `null` methods
    
    This completes the `Foldable` class by two important operations which
    this way can be optimised for the underlying structure more easily.
    
    A minor fix for the `containers` submodule was needed to due name clash
    
    Addresses #9621
    
    Reviewed By: ekmett, dfeuer, austin
    
    Differential Revision: https://phabricator.haskell.org/D250


>---------------------------------------------------------------

e5cca4ab246ca2d1ecdd7c39eefd3157547cb6aa
 compiler/ghci/Debugger.hs                         |  2 +-
 libraries/base/Data/Foldable.hs                   | 10 ++++++++++
 libraries/base/Data/List.hs                       |  2 +-
 libraries/containers                              |  2 +-
 testsuite/tests/ghci/scripts/ghci025.stdout       |  4 +++-
 testsuite/tests/module/mod106.hs                  |  2 +-
 testsuite/tests/parser/should_fail/readFail003.hs |  2 +-
 testsuite/tests/simplCore/should_compile/T7360.hs |  6 ++++--
 testsuite/tests/typecheck/should_compile/faxen.hs |  3 +++
 testsuite/tests/typecheck/should_fail/mc21.hs     |  4 ++--
 testsuite/tests/typecheck/should_fail/mc24.hs     |  4 ++--
 11 files changed, 29 insertions(+), 12 deletions(-)

diff --git a/compiler/ghci/Debugger.hs b/compiler/ghci/Debugger.hs
index 4966714..bd15329 100644
--- a/compiler/ghci/Debugger.hs
+++ b/compiler/ghci/Debugger.hs
@@ -172,7 +172,7 @@ showTerm term = do
            txt_ <- withExtendedLinkEnv [(bname, val)]
                                        (GHC.compileExpr expr)
            let myprec = 10 -- application precedence. TODO Infix constructors
-           let txt = unsafeCoerce# txt_
+           let txt = unsafeCoerce# txt_ :: [a]
            if not (null txt) then
              return $ Just $ cparen (prec >= myprec && needsParens txt)
                                     (text txt)
diff --git a/libraries/base/Data/Foldable.hs b/libraries/base/Data/Foldable.hs
index 688fd06..d8310ca 100644
--- a/libraries/base/Data/Foldable.hs
+++ b/libraries/base/Data/Foldable.hs
@@ -149,6 +149,14 @@ class Foldable t where
     {-# INLINE toList #-}
     toList t = build (\ c n -> foldr c n t)
 
+    -- | Test whether the structure is empty.
+    null :: Foldable t => t a -> Bool
+    null = foldr (\_ _ -> False) True
+
+    -- | Returns the size/length of a finite structure as an 'Int'.
+    length :: Foldable t => t a -> Int
+    length = foldl' (\c _ -> c+1) 0
+
     -- | Does the element occur in the structure?
     elem :: (Foldable t, Eq a) => a -> t a -> Bool
     elem = any . (==)
@@ -186,8 +194,10 @@ instance Foldable [] where
     foldl1  = List.foldl1
     foldr   = List.foldr
     foldr1  = List.foldr1
+    length  = List.length
     maximum = List.maximum
     minimum = List.minimum
+    null    = List.null
     product = List.product
     sum     = List.sum
     toList  = id
diff --git a/libraries/base/Data/List.hs b/libraries/base/Data/List.hs
index 795baec..193ebbc 100644
--- a/libraries/base/Data/List.hs
+++ b/libraries/base/Data/List.hs
@@ -213,4 +213,4 @@ import Data.Traversable
 import Data.OldList hiding ( all, and, any, concat, concatMap, elem, find,
                              foldl, foldl1, foldl', foldr, foldr1, mapAccumL,
                              mapAccumR, maximum, maximumBy, minimum, minimumBy,
-                             notElem, or, product, sum )
+                             length, notElem, null, or, product, sum )
diff --git a/libraries/containers b/libraries/containers
index e84c5d2..085e1b8 160000
--- a/libraries/containers
+++ b/libraries/containers
@@ -1 +1 @@
-Subproject commit e84c5d2145415cb0beacce0909a551ae5e28d396
+Subproject commit 085e1b8b2cfbd1159bbc9f8cbf6a4127cc32227b
diff --git a/testsuite/tests/ghci/scripts/ghci025.stdout b/testsuite/tests/ghci/scripts/ghci025.stdout
index e6b012a..4d21c5f 100644
--- a/testsuite/tests/ghci/scripts/ghci025.stdout
+++ b/testsuite/tests/ghci/scripts/ghci025.stdout
@@ -52,7 +52,9 @@ class Eq a where
   (GHC.Classes.==) :: a -> a -> GHC.Types.Bool
   (GHC.Classes./=) :: a -> a -> GHC.Types.Bool
 -- imported via Prelude, T
-Prelude.length :: [a] -> GHC.Types.Int
+Prelude.length ::
+  Data.Foldable.Foldable t =>
+  forall a. Data.Foldable.Foldable t => t a -> GHC.Types.Int
 -- imported via T
 data T.Integer
   = integer-gmp-0.5.1.0:GHC.Integer.Type.S# GHC.Prim.Int#
diff --git a/testsuite/tests/module/mod106.hs b/testsuite/tests/module/mod106.hs
index a871377..b505971 100644
--- a/testsuite/tests/module/mod106.hs
+++ b/testsuite/tests/module/mod106.hs
@@ -1,7 +1,7 @@
 -- !!! local aliases
 module M where
 
-import qualified Data.List as M
+import qualified Data.OldList as M
 import qualified Data.Maybe as M
 
 x = M.length
diff --git a/testsuite/tests/parser/should_fail/readFail003.hs b/testsuite/tests/parser/should_fail/readFail003.hs
index 8595312..343e1f0 100644
--- a/testsuite/tests/parser/should_fail/readFail003.hs
+++ b/testsuite/tests/parser/should_fail/readFail003.hs
@@ -1,6 +1,6 @@
 -- !!! Irrefutable patterns + guards
 module Read003 where
-
+import Data.OldList; import Prelude hiding (null)
 ~(a,b,c) | nullity b	= a
 	 | nullity c	= a
 	 | otherwise	= a
diff --git a/testsuite/tests/simplCore/should_compile/T7360.hs b/testsuite/tests/simplCore/should_compile/T7360.hs
index 9225bd1..67c5e72 100644
--- a/testsuite/tests/simplCore/should_compile/T7360.hs
+++ b/testsuite/tests/simplCore/should_compile/T7360.hs
@@ -3,6 +3,8 @@
 
 module T7360 where
 
+import Data.OldList as L
+
 data Foo = Foo1 | Foo2 | Foo3 !Int
     
 fun1 :: Foo -> ()
@@ -15,5 +17,5 @@ fun1 x = case x of
 fun2 x = (fun1 Foo1,  -- Keep -ddump-simpl output 
                       -- in a predicatable order
          case x of
-          [] -> length x
-          (_:_) -> length x)
+          [] -> L.length x
+          (_:_) -> L.length x)
diff --git a/testsuite/tests/typecheck/should_compile/faxen.hs b/testsuite/tests/typecheck/should_compile/faxen.hs
index ddc8f7b..f65ee71 100644
--- a/testsuite/tests/typecheck/should_compile/faxen.hs
+++ b/testsuite/tests/typecheck/should_compile/faxen.hs
@@ -6,6 +6,9 @@
 
 module ShouldCompile where
 
+import Data.OldList (null)
+import Prelude hiding (null)
+
 class HasEmpty a where
   isEmpty :: a -> Bool
 
diff --git a/testsuite/tests/typecheck/should_fail/mc21.hs b/testsuite/tests/typecheck/should_fail/mc21.hs
index 601403a..adb4b91 100644
--- a/testsuite/tests/typecheck/should_fail/mc21.hs
+++ b/testsuite/tests/typecheck/should_fail/mc21.hs
@@ -1,13 +1,13 @@
 -- Checks that the correct type is used checking the using clause of the group
 
 {-# OPTIONS_GHC -XMonadComprehensions -XTransformListComp #-}
-
 module ShouldFail where
 import GHC.Exts( the )
+import Data.OldList
 
 data Unorderable = Gnorf | Pinky | Brain
 
-foo = [ length x
+foo = [ Data.OldList.length x
       | x <- [Gnorf, Brain]
       , then group using take 5
       ]
diff --git a/testsuite/tests/typecheck/should_fail/mc24.hs b/testsuite/tests/typecheck/should_fail/mc24.hs
index 9186721..281f4ad 100644
--- a/testsuite/tests/typecheck/should_fail/mc24.hs
+++ b/testsuite/tests/typecheck/should_fail/mc24.hs
@@ -2,10 +2,10 @@
 -- the group when a by clause is present
 
 {-# OPTIONS_GHC -XMonadComprehensions -XTransformListComp #-}
-
 module ShouldFail where
+import Data.OldList
 
-foo = [ length x
+foo = [ Data.OldList.length x
       | x <- [1..10]
       , then group by x using take 2
       ]

More information about the ghc-commits mailing list