General improvements

* Remove unnecessary constraints from `Data.BitSet.Generic`.
* Use a more streamlined implementation of `foldl'` and `foldr'`
  when possible.
* Update Cabal file to indicate required extensions.
* Make the tests work again.

Author: treeowl

.gitignore

@@ -1,5 +1,10 @@
 cabal-dev
 dist
+.cabal-sandbox/
+cabal.sandbox.config
+.stack-work/
+*.hi
+*.o
 
 # This file will be autogenerated on 'cabal build'.
 cbits/GmpDerivedConstants.h

bitset.cabal

@@ -16,8 +16,8 @@ Bug-reports:          http://github.com/lambda-llama/bitset/issues
 Stability:            Experimental
 Cabal-Version:        >= 1.12
 Build-type:           Custom
-Tested-with:          GHC >= 7.4.1
-Extra-Source-Files:   bin/mkDerivedGmpConstants.c
+Tested-with:          GHC == 7.4.1, GHC == 7.6.3, GHC == 7.8.4
+Extra-Source-Files:   bin/mkDerivedGmpConstants.c, include/bitset.h
 
 Source-repository head
   Type:     git
@@ -27,9 +27,15 @@ Library
   Hs-source-dirs:     src
   Ghc-options:        -Wall -fno-warn-orphans
   Default-language:   Haskell2010
+  Other-extensions:   CPP, NamedFieldPuns, MagicHash, UnboxedTuples,
+                      BangPatterns, ForeignFunctionInterface,
+                      GHCForeignImportPrim, MagicHash,
+                      UnliftedFFITypes, UnboxedTuples,
+                      GeneralizedNewtypeDeriving, TypeFamilies,
+                      DeriveDataTypeable
 
   C-sources:          cbits/gmp-extras.cmm
-  Include-dirs:       cbits
+  Include-dirs:       cbits, include
 
   if os(windows)
     Extra-libraries:  gmp-10
@@ -52,6 +58,7 @@ Test-suite bitset-tests
   Hs-source-dirs:     tests
   Ghc-options:        -Wall -O2 -fno-warn-orphans
   Default-language:   Haskell2010
+  Other-extensions:   CPP
 
   Type:               exitcode-stdio-1.0
   Main-is:            Tests.hs
@@ -66,9 +73,10 @@ Benchmark bitset-benchmarks
   Hs-source-dirs:     src benchmarks
   Ghc-options:        -Wall -fno-warn-orphans -O2 -optc-O3 -optc-msse4.1
   Default-language:   Haskell2010
+  Other-extensions:   CPP, ExistentialQuantification
 
   C-sources:          cbits/gmp-extras.cmm
-  Include-dirs:       cbits
+  Include-dirs:       cbits, include
   Extra-libraries:    gmp
 
   Type:               exitcode-stdio-1.0

include/bitset.h

@@ -0,0 +1,39 @@
+/*
+ * Common macros for bitset
+ */
+
+#ifndef HASKELL_BITSET_H
+#define HASKELL_BITSET_H
+
+/*
+ * We use cabal-generated MIN_VERSION_base to adapt to changes of base.
+ * Nevertheless, as a convenience, we also allow compiling without cabal by
+ * defining an approximate MIN_VERSION_base if needed. The alternative version
+ * guesses the version of base using the version of GHC. This is usually
+ * sufficiently accurate. However, it completely ignores minor version numbers,
+ * and it makes the assumption that a pre-release version of GHC will ship with
+ * base libraries with the same version numbers as the final release. This
+ * assumption is violated in certain stages of GHC development, but in practice
+ * this should very rarely matter, and will not affect any released version.
+ */
+#ifndef MIN_VERSION_base
+#if __GLASGOW_HASKELL__ >= 711
+#define MIN_VERSION_base(major1,major2,minor) (((major1)<4)||(((major2) == 4)&&((major2)<=9)))
+#elif __GLASGOW_HASKELL__ >= 709
+#define MIN_VERSION_base(major1,major2,minor) (((major1)<4)||(((major1) == 4)&&((major2)<=8)))
+#elif __GLASGOW_HASKELL__ >= 707
+#define MIN_VERSION_base(major1,major2,minor) (((major1)<4)||(((major1) == 4)&&((major2)<=7)))
+#elif __GLASGOW_HASKELL__ >= 705
+#define MIN_VERSION_base(major1,major2,minor) (((major1)<4)||(((major1) == 4)&&((major2)<=6)))
+#elif __GLASGOW_HASKELL__ >= 703
+#define MIN_VERSION_base(major1,major2,minor) (((major1)<4)||(((major1) == 4)&&((major2)<=5)))
+#elif __GLASGOW_HASKELL__ >= 701
+#define MIN_VERSION_base(major1,major2,minor) (((major1)<4)||(((major1) == 4)&&((major2)<=4)))
+#elif __GLASGOW_HASKELL__ >= 700
+#define MIN_VERSION_base(major1,major2,minor) (((major1)<4)||(((major1) == 4)&&((major2)<=3)))
+#else
+#define MIN_VERSION_base(major1,major2,minor) (0)
+#endif
+#endif
+
+#endif

src/Data/BitSet/Dynamic.hs

@@ -2,6 +2,8 @@
 {-# LANGUAGE MagicHash #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 
+#include <bitset.h>
+
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Data.BitSet.Dynamic
@@ -122,11 +124,10 @@ instance Bits FasterInteger where
     isSigned = isSigned . unFI
     {-# INLINE isSigned #-}
 
-    bitSize = bitSize . unFI
-    {-# INLINE bitSize #-}
+    bitSize _ = error "bitSize: FasterInteger does not support bitSize."
 
-#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 707)
-    bitSizeMaybe = bitSizeMaybe . unFI
+#if MIN_VERSION_base(4,7,0)
+    bitSizeMaybe _ = Nothing
     {-# INLINE bitSizeMaybe #-}
 #endif
 

src/Data/BitSet/Generic.hs

@@ -31,6 +31,8 @@
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 
+#include <bitset.h>
+
 module Data.BitSet.Generic
     (
     -- * Bit set type
@@ -79,6 +81,9 @@ import Control.Applicative ((<$>))
 import Control.DeepSeq (NFData(..))
 import Data.Bits (Bits, (.|.), (.&.), complement, bit,
                   testBit, setBit, clearBit, popCount)
+#if MIN_VERSION_base(4,7,0)
+import Data.Bits (bitSizeMaybe, isSigned, unsafeShiftR, zeroBits)
+#endif
 import Data.Data (Typeable)
 import Data.Monoid (Monoid(..))
 import Foreign (Storable)
@@ -94,29 +99,35 @@ import qualified Data.List as List
 newtype BitSet c a = BitSet { getBits :: c }
    deriving (Eq, NFData, Storable, Ord, Typeable)
 
-instance (Enum a, Read a, Bits c, Num c) => Read (BitSet c a) where
+instance (Enum a, Read a, Bits c) => Read (BitSet c a) where
     readPrec = parens . prec 10 $ do
         Ident "fromList" <- lexP
         fromList <$> readPrec
 
-instance (Enum a, Show a, Bits c,  Num c) => Show (BitSet c a) where
+instance (Enum a, Show a, Bits c) => Show (BitSet c a) where
     showsPrec p bs = showParen (p > 10) $
                      showString "fromList " . shows (toList bs)
 
-instance (Enum a, Bits c, Num c) => Monoid (BitSet c a) where
+instance Bits c => Monoid (BitSet c a) where
     mempty  = empty
     mappend = union
 
 #if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 707)
-instance (Enum a, Bits c, Num c) => IsList (BitSet c a) where
+instance (Enum a, Bits c) => IsList (BitSet c a) where
     type Item (BitSet c a) = a
     fromList = fromList
     toList = toList
 #endif
 
+#if !MIN_VERSION_base(4,7,0)
+zeroBits :: Bits c => c
+zeroBits = bit 0 `clearBit` 0
+{-# INLINE zeroBits #-}
+#endif
+
 -- | /O(1)/. Is the bit set empty?
-null :: (Eq c, Num c) => BitSet c a -> Bool
-null = (== 0) . getBits
+null :: Bits c => BitSet c a -> Bool
+null = (== zeroBits) . getBits
 {-# INLINE null #-}
 
 -- | /O(1)/. The number of elements in the bit set.
@@ -136,22 +147,22 @@ notMember x = not . member x
 
 -- | /O(max(n, m))/. Is this a subset? (@s1 `isSubsetOf` s2@) tells whether
 -- @s1@ is a subset of @s2@.
-isSubsetOf :: (Bits c, Eq c) => BitSet c a -> BitSet c a -> Bool
+isSubsetOf :: Bits c => BitSet c a -> BitSet c a -> Bool
 isSubsetOf (BitSet bits1) (BitSet bits2) = bits2 .|. bits1 == bits2
 {-# INLINE isSubsetOf #-}
 
 -- | /O(max(n, m)/. Is this a proper subset? (ie. a subset but not equal).
-isProperSubsetOf :: (Bits c, Eq c) => BitSet c a -> BitSet c a -> Bool
+isProperSubsetOf :: Bits c => BitSet c a -> BitSet c a -> Bool
 isProperSubsetOf bs1 bs2 = bs1 `isSubsetOf` bs2 && bs1 /= bs2
 {-# INLINE isProperSubsetOf #-}
 
 -- | The empty bit set.
-empty :: (Enum a, Bits c, Num c) => BitSet c a
-empty = BitSet 0
+empty :: Bits c => BitSet c a
+empty = BitSet zeroBits
 {-# INLINE empty #-}
 
 -- | O(1). Create a singleton set.
-singleton :: (Enum a, Bits c, Num c) => a -> BitSet c a
+singleton :: (Enum a, Bits c) => a -> BitSet c a
 singleton = BitSet . bit . fromEnum
 {-# INLINE singleton #-}
 
@@ -186,7 +197,7 @@ intersection (BitSet bits1) (BitSet bits2) = BitSet $ bits1 .&. bits2
 
 -- | /O(d * n)/ Transform this bit set by applying a function to every
 -- value.  Resulting bit set may be smaller then the original.
-map :: (Enum a, Enum b, Bits c, Num c) => (a -> b) -> BitSet c a -> BitSet c b
+map :: (Enum a, Enum b, Bits c) => (a -> b) -> BitSet c a -> BitSet c b
 map f = foldl' (\bs -> (`insert` bs) . f) empty
 {-# INLINE map #-}
 
@@ -195,37 +206,63 @@ map f = foldl' (\bs -> (`insert` bs) . f) empty
 -- operator is evaluated before before using the result in the next
 -- application.  This function is strict in the starting value.
 foldl' :: (Enum a, Bits c) => (b -> a -> b) -> b -> BitSet c a -> b
-foldl' f acc0  (BitSet bits) = go acc0 (popCount bits) 0 where
-  go !acc 0 _b = acc
-  go !acc !n b = if bits `testBit` b
-                 then go (f acc $ toEnum b) (pred n) (succ b)
-                 else go acc n (succ b)
+#if MIN_VERSION_base(4,7,0)
+-- If the bit set is represented by an unsigned type
+-- then we can shift the bits off one by one until we're
+-- left with all zeros. If the type is fairly narrow, then
+-- this is likely to be cheap. In particular, in this case
+-- we don't need to calculate the `popCount` and all shifts
+-- are by fixed amounts.
+foldl' f acc0 (BitSet bits0)
+  | not (isSigned bits0) && maybe False (<= 128) (bitSizeMaybe bits0) =
+      go acc0 bits0 0
+  where
+    go !acc !bits !b
+      | bits == zeroBits = acc
+      | bits `testBit` 0 = go (f acc $ toEnum b) (bits `unsafeShiftR` 1) (b + 1)
+      | otherwise = go acc (bits `unsafeShiftR` 1) (b + 1)
+#endif
+foldl' f acc0 (BitSet bits) = go acc0 (popCount bits) 0
+  where
+    go !acc 0 !_b = acc
+    go !acc n !b  = if bits `testBit` b
+                    then go (f acc $ toEnum b) (n - 1) (b + 1)
+                    else go acc n (b + 1)
 {-# INLINE foldl' #-}
 
 -- | /O(d * n)/ Reduce this bit set by applying a binary function to
 -- all elements, using the given starting value.
 foldr :: (Enum a, Bits c) => (a -> b -> b) -> b -> BitSet c a -> b
+#if MIN_VERSION_base(4,7,0)
+foldr f acc0 (BitSet bits0)
+  | not (isSigned bits0) && maybe False (<= 128) (bitSizeMaybe bits0) = go bits0 0
+  where
+    go !bits !b
+      | bits == zeroBits = acc0
+      | bits `testBit` 0 = toEnum b `f` go (bits `unsafeShiftR` 1) (b + 1)
+      | otherwise = go (bits `unsafeShiftR` 1) (b + 1)
+#endif
 foldr f acc0 (BitSet bits) = go (popCount bits) 0 where
   go 0 _b = acc0
   go !n b = if bits `testBit` b
-            then toEnum b `f` go (pred n) (succ b)
-            else go n (succ b)
+            then toEnum b `f` go (n - 1) (b + 1)
+            else go n (b + 1)
 {-# INLINE foldr #-}
 
 -- | /O(d * n)/ Filter this bit set by retaining only elements satisfying
 -- predicate.
-filter :: (Enum a, Bits c, Num c) => (a -> Bool) -> BitSet c a -> BitSet c a
+filter :: (Enum a, Bits c) => (a -> Bool) -> BitSet c a -> BitSet c a
 filter f = foldl' (\bs x -> if f x then x `insert` bs else bs) empty
 {-# INLINE filter #-}
 
 -- | /O(d * n)/. Convert this bit set set to a list of elements.
-toList :: (Enum a, Bits c, Num c) => BitSet c a -> [a]
+toList :: (Enum a, Bits c) => BitSet c a -> [a]
 toList bs = build (\k z -> foldr k z bs)
 {-# INLINE [0] toList #-}
 
 -- | /O(d * n)/. Make a bit set from a list of elements.
-fromList :: (Enum a, Bits c, Num c) => [a] -> BitSet c a
-fromList = BitSet . List.foldl' (\i x -> i `setBit` fromEnum x) 0
+fromList :: (Enum a, Bits c) => [a] -> BitSet c a
+fromList = List.foldl' (\i x -> insert x i) empty
 {-# INLINE [0] fromList #-}
 {-# RULES
 "fromList/toList"    forall bs. fromList (toList bs) = bs