Merge pull request #156 from adubovik/master

Removed unnecessary strictness in IntSet.foldl accumulator.

Author: foxik

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

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

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