[commit: packages/containers] changelog-foldtree, cleaned_bugfix394, master, merge-doc-target, merge-fixes-5.9, merge-restrict-fix-5.8, revert-184-generic, revert-408-bugfix_394: Removed unnecessary strictness in IntSet.foldl accumulator. (bdd7b33)

git at git.haskell.org git at git.haskell.org
Mon Apr 17 21:38:23 UTC 2017


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

On branches: changelog-foldtree,cleaned_bugfix394,master,merge-doc-target,merge-fixes-5.9,merge-restrict-fix-5.8,revert-184-generic,revert-408-bugfix_394
Link       : http://git.haskell.org/packages/containers.git/commitdiff/bdd7b3378ebd218d935b62fdf980f76fd7d98a4b

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

commit bdd7b3378ebd218d935b62fdf980f76fd7d98a4b
Author: Anton Dubovik <gunner.kade at gmail.com>
Date:   Fri May 15 00:45:50 2015 +0300

    Removed unnecessary strictness in IntSet.foldl accumulator.


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

bdd7b3378ebd218d935b62fdf980f76fd7d98a4b
 Data/IntSet/Base.hs        |  1 -
 containers.cabal           | 18 ++++++++++++++++++
 tests/intset-strictness.hs | 46 ++++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 64 insertions(+), 1 deletion(-)

diff --git a/Data/IntSet/Base.hs b/Data/IntSet/Base.hs
index c89bd18..3dc473c 100644
--- a/Data/IntSet/Base.hs
+++ b/Data/IntSet/Base.hs
@@ -882,7 +882,6 @@ foldl f z = \t ->      -- Use lambda t to be inlinable with two arguments only.
                         | otherwise -> go (go z l) r
             _ -> go z t
   where
-    STRICT_1_OF_2(go)
     go z' Nil           = z'
     go z' (Tip kx bm)   = foldlBits kx f z' bm
     go z' (Bin _ _ l r) = go (go z' l) r
diff --git a/containers.cabal b/containers.cabal
index d7db653..6f4baaf 100644
--- a/containers.cabal
+++ b/containers.cabal
@@ -252,3 +252,21 @@ test-suite intmap-strictness-properties
 
   ghc-options: -Wall
   include-dirs: include
+
+test-suite intset-strictness-properties
+  hs-source-dirs: tests, .
+  main-is: intset-strictness.hs
+  type: exitcode-stdio-1.0
+
+  build-depends:
+    array,
+    base >= 4.2 && < 5,
+    ChasingBottoms,
+    deepseq >= 1.2 && < 1.5,
+    QuickCheck >= 2.4.0.1,
+    ghc-prim,
+    test-framework >= 0.3.3,
+    test-framework-quickcheck2 >= 0.2.9
+
+  ghc-options: -Wall
+  include-dirs: include
diff --git a/tests/intset-strictness.hs b/tests/intset-strictness.hs
new file mode 100644
index 0000000..b7c4097
--- /dev/null
+++ b/tests/intset-strictness.hs
@@ -0,0 +1,46 @@
+{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module Main (main) where
+
+import Prelude hiding (foldl)
+
+import Test.ChasingBottoms.IsBottom
+import Test.Framework (Test, defaultMain, testGroup)
+import Test.Framework.Providers.QuickCheck2 (testProperty)
+
+import Data.IntSet
+
+------------------------------------------------------------------------
+-- * Properties
+
+------------------------------------------------------------------------
+-- ** Lazy module
+
+pFoldlAccLazy :: Int -> Bool
+pFoldlAccLazy k =
+  isn'tBottom $ foldl (\_ x -> x) (bottom :: Int) (singleton k)
+
+------------------------------------------------------------------------
+-- * Test list
+
+tests :: [Test]
+tests =
+    [
+    -- Basic interface
+      testGroup "IntSet"
+      [ testProperty "foldl is lazy in accumulator" pFoldlAccLazy
+      ]
+    ]
+
+------------------------------------------------------------------------
+-- * Test harness
+
+main :: IO ()
+main = defaultMain tests
+
+------------------------------------------------------------------------
+-- * Utilities
+
+isn'tBottom :: a -> Bool
+isn'tBottom = not . isBottom



More information about the ghc-commits mailing list