diff --git a/CHANGES b/CHANGES --- a/CHANGES +++ b/CHANGES @@ -3,6 +3,13 @@ Here you can see the full list of changes between each bitset release. +Version 1.4.6 +------------- + +Released on July 17th, 2013 + +- Fixed build issues on Windows, see #9 on GitHub for details. + Version 1.4.5 ------------- diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -13,6 +13,7 @@ import Distribution.Simple.Program (gccProgram, lookupProgram, runProgram) import Distribution.Simple.Setup (BuildFlags) import Distribution.Simple.Utils (die, rawSystemStdout) +import Distribution.System (OS(..), buildOS) import Distribution.Verbosity (silent) main :: IO () @@ -27,7 +28,7 @@ mkDerivedGmpConstants pkg_descr lbi userHooks flags = case lookupProgram gccProgram (withPrograms lbi) of Just gcc -> - let path = "src" "mkDerivedGmpConstants" in do + let path = "src" exeName in do runProgram silent gcc ["bin" "mkDerivedGmpConstants.c", "-o", path] output <- rawSystemStdout silent path [] @@ -35,3 +36,8 @@ removeFile path buildHook simpleUserHooks pkg_descr lbi userHooks flags Nothing -> die "Failed to find GCC!" + where + exeName :: FilePath + exeName = case buildOS of + Windows -> "mkDerivedGmpConstants.exe" + _ -> "mkDerivedGmpConstants" diff --git a/bin/mkDerivedGmpConstants.c b/bin/mkDerivedGmpConstants.c --- a/bin/mkDerivedGmpConstants.c +++ b/bin/mkDerivedGmpConstants.c @@ -12,7 +12,7 @@ * ------------------------------------------------------------------------*/ #include -#include "gmp.h" +#include "./gmp.h" #define str(a,b) #a "_" #b diff --git a/bitset.cabal b/bitset.cabal --- a/bitset.cabal +++ b/bitset.cabal @@ -1,5 +1,5 @@ Name: bitset -Version: 1.4.5 +Version: 1.4.6 Synopsis: A space-efficient set data structure. Description: A /bit set/ is a compact data structure, which maintains a set of members @@ -30,7 +30,11 @@ C-sources: cbits/gmp-extras.cmm Include-dirs: cbits - Extra-libraries: gmp + + if os(windows) + Extra-libraries: gmp-10 + else + Extra-libraries: gmp Build-depends: base >= 4.4.0 && < 4.7 , deepseq == 1.3.* diff --git a/src/Data/BitSet/Dynamic.hs b/src/Data/BitSet/Dynamic.hs --- a/src/Data/BitSet/Dynamic.hs +++ b/src/Data/BitSet/Dynamic.hs @@ -29,7 +29,7 @@ module Data.BitSet.Dynamic ( -- * Bit set type - FasterInteger + FasterInteger(FasterInteger) , BitSet -- * Operators diff --git a/src/Data/BitSet/Generic.hs b/src/Data/BitSet/Generic.hs --- a/src/Data/BitSet/Generic.hs +++ b/src/Data/BitSet/Generic.hs @@ -95,7 +95,11 @@ data GBitSet c a = (Enum a, Bits c, Num c) => BitSet { _n :: {-# UNPACK #-} !Int -- ^ Number of elements in the bit set. +#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 708) + , _bits :: {-# UNPACK #-} !c -- ^ Bit container. +#else , _bits :: !c -- ^ Bit container. +#endif } deriving Typeable diff --git a/src/GHC/Integer/GMP/TypeExt.hs b/src/GHC/Integer/GMP/TypeExt.hs --- a/src/GHC/Integer/GMP/TypeExt.hs +++ b/src/GHC/Integer/GMP/TypeExt.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE BangPatterns #-} @@ -9,34 +10,53 @@ , clearBitInteger ) where -import Data.Bits (popCount, testBit, clearBit) -import GHC.Base (Int(..)) +#include "MachDeps.h" + import GHC.Integer.GMP.Internals (Integer(..)) import GHC.Integer.GMP.Prim (int2Integer#) -import GHC.Prim (Int#, (/=#)) +import GHC.Prim (Int#, (/=#), (>=#), (<#), (-#), + int2Word#, word2Int#, popCnt#, + negateInt#, and#, or#, xor#, uncheckedIShiftL#) import GHC.Integer.GMP.PrimExt (popCountInteger#, testBitInteger#, setBitInteger#, clearBitInteger#) popCountInteger :: Integer -> Int# -popCountInteger (S# i) = let !(I# n) = popCount (I# i) in n +popCountInteger (S# i) = word2Int# (popCnt# (int2Word# i)) popCountInteger (J# s d) = popCountInteger# s d {-# NOINLINE popCountInteger #-} testBitInteger :: Integer -> Int# -> Bool -testBitInteger (S# j) i = testBit (I# j) (I# i) +testBitInteger (S# j) i + | i <# 0# = False + | i <# (WORD_SIZE_IN_BITS# -# 1#) = + let !mask = 1# `uncheckedIShiftL#` i in + word2Int# (int2Word# j `and#` int2Word# mask) /=# 0# + | otherwise = + let !(# s, d #) = int2Integer# j in testBitInteger (J# s d) i testBitInteger (J# s d) i = testBitInteger# s d i /=# 0# {-# NOINLINE testBitInteger #-} setBitInteger :: Integer -> Int# -> Integer -setBitInteger (S# j) i = - let !(# s, d #) = int2Integer# j in setBitInteger (J# s d) i +setBitInteger (S# j) i + | i <# 0# = S# j + | i <# (WORD_SIZE_IN_BITS# -# 1#) = + let !mask = 1# `uncheckedIShiftL#` i in + S# (word2Int# (int2Word# j `or#` int2Word# mask)) + | otherwise = + let !(# s, d #) = int2Integer# j in setBitInteger (J# s d) i setBitInteger (J# s d) i = let !(# s', d' #) = setBitInteger# s d i in J# s' d' {-# NOINLINE setBitInteger #-} clearBitInteger :: Integer -> Int# -> Integer -clearBitInteger (S# j) i = let !(I# j') = clearBit (I# j) (I# i) in S# j' +clearBitInteger (S# j) i + | i <# 0# || i >=# (WORD_SIZE_IN_BITS# -# 1#) = S# j + | otherwise = + let !mask = + int2Word# (1# `uncheckedIShiftL#` i) `xor#` + int2Word# (negateInt# 1#) + in S# (word2Int# (int2Word# j `and#` mask)) clearBitInteger (J# s d) i = let !(# s', d' #) = clearBitInteger# s d i in J# s' d' {-# NOINLINE clearBitInteger #-} diff --git a/tests/Tests.hs b/tests/Tests.hs --- a/tests/Tests.hs +++ b/tests/Tests.hs @@ -1,20 +1,24 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE FlexibleInstances #-} module Main (main) where import Control.Applicative ((<$>)) +import Data.Bits (popCount, testBit, setBit, clearBit) +import Data.Int (Int16) import Data.List ((\\), intersect, union, nub, sort) import Data.Monoid ((<>), mempty) import Data.Word (Word16) import Foreign (Storable(..), allocaBytes) -import Test.Framework (Test, defaultMain) +import Test.Framework (Test, testGroup, defaultMain) import Test.Framework.Providers.QuickCheck2 (testProperty) import Test.QuickCheck (Property, Arbitrary(..), (==>), classify) import Test.QuickCheck.Monadic (monadicIO, assert, run) import Data.BitSet (BitSet) +import Data.BitSet.Dynamic (FasterInteger(..)) import Data.BitSet.Generic (GBitSet) import qualified Data.BitSet as BS import qualified Data.BitSet.Generic as GS @@ -28,6 +32,9 @@ instance Show (Word16 -> a) where show = const "FUNCTION" +instance Arbitrary FasterInteger where + arbitrary = FasterInteger <$> arbitrary + propSize :: [Word16] -> Bool propSize = go . nub where go xs = length xs == BS.size (BS.fromList xs) @@ -177,31 +184,89 @@ where size = sizeOf storable + +#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 706) +propPopCount :: FasterInteger -> Property +propPopCount xfi = xfi >= 0 ==> popCount xfi == popCount xi where + xi :: Integer + xi = fromIntegral xfi +#endif + +propTestBit :: FasterInteger -> Int16 -> Property +propTestBit xfi i = xfi >= 0 ==> testBit xfi bit == testBit xi bit where + bit :: Int + bit = fromIntegral i + + xi :: Integer + xi = fromIntegral xfi + +propSetBit :: FasterInteger -> Int16 -> Property +propSetBit xfi i = + xfi >= 0 ==> setBit xfi bit == FasterInteger (setBit xi bit) + where + bit :: Int + bit = fromIntegral i + + xi :: Integer + xi = fromIntegral xfi + +propClearBit :: FasterInteger -> Int16 -> Property +propClearBit xfi i = + xfi >= 0 ==> + classify True "x not in bs" $ + clearBit xfi bit == FasterInteger (clearBit xi bit) + + where + bit :: Int + bit = fromIntegral i + + xi :: Integer + xi = fromIntegral xfi + + main :: IO () main = defaultMain tests where tests :: [Test] - tests = [ testProperty "size" propSize - , testProperty "size after insert" propSizeAfterInsert - , testProperty "size after delete" propSizeAfterDelete - , testProperty "insert" propInsertMember - , testProperty "delete" propDeleteMember - , testProperty "insert and delete are idempotent" propInsertDeleteIdempotent - , testProperty "delete is idempotent" propDeleteIdempotent - , testProperty "insert is idempotent" propInsertIdempotent - , testProperty "toList" propToList - , testProperty "fromList" propFromList - , testProperty "empty" propEmpty - , testProperty "native empty is null" propNullEmpty - , testProperty "generated empty is null" propNullAfterDelete - , testProperty "intersection with self" propIntersectionWithSelf - , testProperty "intersection" propIntersection - , testProperty "difference with self" propDifferenceWithSelf - , testProperty "difference" propDifference - , testProperty "monoid laws" propMonoidLaws - , testProperty "is subset of self" propIsSubsetOfSelf - , testProperty "is subset of" propIsSubsetOf - , testProperty "show read" propShowRead - , testProperty "map" propMap - , testProperty "filter" propFilter - , testProperty "storable instance" propStorable + tests = [ testGroup "Data.BitSet" testsBitSet + , testGroup "GHC.Integer.GMP" testsFasterInteger ] + + testsBitSet :: [Test] + testsBitSet = + [ testProperty "size" propSize + , testProperty "size after insert" propSizeAfterInsert + , testProperty "size after delete" propSizeAfterDelete + , testProperty "insert" propInsertMember + , testProperty "delete" propDeleteMember + , testProperty "insert and delete are idempotent" propInsertDeleteIdempotent + , testProperty "delete is idempotent" propDeleteIdempotent + , testProperty "insert is idempotent" propInsertIdempotent + , testProperty "toList" propToList + , testProperty "fromList" propFromList + , testProperty "empty" propEmpty + , testProperty "native empty is null" propNullEmpty + , testProperty "generated empty is null" propNullAfterDelete + , testProperty "intersection with self" propIntersectionWithSelf + , testProperty "intersection" propIntersection + , testProperty "difference with self" propDifferenceWithSelf + , testProperty "difference" propDifference + , testProperty "monoid laws" propMonoidLaws + , testProperty "is subset of self" propIsSubsetOfSelf + , testProperty "is subset of" propIsSubsetOf + , testProperty "show read" propShowRead + , testProperty "map" propMap + , testProperty "filter" propFilter + , testProperty "storable instance" propStorable + ] + + testsFasterInteger :: [Test] + testsFasterInteger = + [ +#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 706) + testProperty "pop count" propPopCount + , +#endif + testProperty "test bit" propTestBit + , testProperty "set bit" propSetBit + , testProperty "clear bit" propClearBit + ]