bitset 1.4.1 → 1.4.2
raw patch · 8 files changed
+220/−56 lines, 8 filesbuild-type:Customsetup-changed
Files
- CHANGES +7/−0
- Setup.hs +32/−2
- bitset.cabal +13/−3
- cbits/gmp-extras.cmm +91/−0
- src/Data/BitSet/Dynamic.hs +8/−50
- src/Data/BitSet/Generic.hs +1/−1
- src/GHC/Integer/GMP/PrimExt.hs +26/−0
- src/GHC/Integer/GMP/TypeExt.hs +42/−0
CHANGES view
@@ -3,6 +3,13 @@ Here you can see the full list of changes between each bitset release. +Version 1.4.2+-------------++- Switched to GMP bit fiddling functions, the corresponding patch for+ 'integer-gmp' was submitted to GHC, see+ http://hackage.haskell.org/trac/ghc/ticket/7860+ Version 1.4.1 -------------
Setup.hs view
@@ -1,6 +1,36 @@ #!/usr/bin/env runhaskell+{-# LANGUAGE NamedFieldPuns #-}+{-# OPTIONS_GHC -Wall -Werror #-} -import Distribution.Simple (defaultMain)+import System.Directory (removeFile)+import System.FilePath ((</>)) +import Distribution.PackageDescription (PackageDescription)+import Distribution.Simple (UserHooks(..),+ defaultMainWithHooks, simpleUserHooks)+import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..))+import Distribution.Simple.Program (gccProgram, lookupProgram, runProgram)+import Distribution.Simple.Setup (BuildFlags)+import Distribution.Simple.Utils (die, rawSystemStdout, writeFileAtomic)+import Distribution.Verbosity (silent)+ main :: IO ()-main = defaultMain+main = defaultMainWithHooks+ simpleUserHooks { buildHook = mkDerivedGmpConstants }+ where+ mkDerivedGmpConstants :: PackageDescription+ -> LocalBuildInfo+ -> UserHooks+ -> BuildFlags+ -> IO ()+ mkDerivedGmpConstants pkg_descr lbi userHooks flags =+ case lookupProgram gccProgram (withPrograms lbi) of+ Just gcc ->+ let path = "src" </> "mkDerivedGmpConstants" in do+ runProgram silent gcc+ ["bin" </> "mkDerivedGmpConstants.c", "-o", path]+ output <- rawSystemStdout silent path []+ writeFileAtomic ("cbits" </> "GmpDerivedConstants.h") output+ removeFile path+ buildHook simpleUserHooks pkg_descr lbi userHooks flags+ Nothing -> die "Failed to find GCC!"
bitset.cabal view
@@ -1,5 +1,5 @@ Name: bitset-Version: 1.4.1+Version: 1.4.2 Synopsis: A space-efficient set data structure. Description: A /bit set/ is a compact data structure, which maintains a set of members@@ -15,8 +15,8 @@ Bug-reports: http://github.com/lambda-llama/bitset/issues Stability: Experimental Cabal-Version: >= 1.12-Build-type: Simple-Tested-with: GHC >= 7.4.2+Build-type: Custom+Tested-with: GHC >= 7.4.1 Source-repository head Type: git@@ -27,6 +27,10 @@ Ghc-options: -Wall -fno-warn-orphans Default-language: Haskell2010 + C-sources: cbits/gmp-extras.cmm+ Include-dirs: cbits+ Extra-libraries: gmp+ Build-depends: base >= 4.4.0 && < 4.7 , deepseq == 1.3.* , integer-gmp@@ -36,6 +40,8 @@ , Data.BitSet.Dynamic , Data.BitSet.Generic , Data.BitSet.Word+ Other-modules: GHC.Integer.GMP.PrimExt+ , GHC.Integer.GMP.TypeExt Test-suite bitset-tests Hs-source-dirs: tests@@ -55,6 +61,10 @@ Hs-source-dirs: src benchmarks Ghc-options: -Wall -fno-warn-orphans -O2 -optc-O3 -optc-msse4.1 Default-language: Haskell2010++ C-sources: cbits/gmp-extras.cmm+ Include-dirs: cbits+ Extra-libraries: gmp Type: exitcode-stdio-1.0 Main-is: Benchmarks.hs
+ cbits/gmp-extras.cmm view
@@ -0,0 +1,91 @@+#include "Cmm.h"+#include "GmpDerivedConstants.h"++// TODO(superbobry): in the future release the syntax for calling+// foreign funcations will CHANGE.++import "integer-gmp" __gmpz_init_set;+import "integer-gmp" __gmpz_popcount;+import "integer-gmp" __gmpz_tstbit;+import "integer-gmp" __gmpz_setbit;+import "integer-gmp" __gmpz_clrbit;++#define GMP_TAKE1_UL1_RET1(name,mp_fun) \+name \+{ \+ CInt s; \+ W_ d; \+ CLong ul; \+ W_ mp_tmp; \+ W_ mp_result; \+ \+ STK_CHK_GEN(2 * SIZEOF_MP_INT, R2, name); \+ MAYBE_GC(R2_PTR, name); \+ \+ s = W_TO_INT(R1); \+ d = R2; \+ ul = R3; \+ \+ mp_tmp = Sp - 1 * SIZEOF_MP_INT; \+ mp_result = Sp - 2 * SIZEOF_MP_INT; \+ MP_INT__mp_alloc(mp_tmp) = W_TO_INT(BYTE_ARR_WDS(d)); \+ MP_INT__mp_size(mp_tmp) = (s); \+ MP_INT__mp_d(mp_tmp) = BYTE_ARR_CTS(d); \+ \+ foreign "C" __gmpz_init_set(mp_result "ptr", mp_tmp "ptr") [];\+ \+ /* Perform the operation */ \+ foreign "C" mp_fun(mp_result "ptr", ul) []; \+ \+ RET_NP(TO_W_(MP_INT__mp_size(mp_result)), \+ MP_INT__mp_d(mp_result) - SIZEOF_StgArrWords); \+}++GMP_TAKE1_UL1_RET1(integer_cmm_setBitIntegerzh, __gmpz_setbit)+GMP_TAKE1_UL1_RET1(integer_cmm_clearBitIntegerzh, __gmpz_clrbit)++integer_cmm_testBitIntegerzh+{+ CInt s, res;+ CLong ul;+ W_ d;+ W_ mp_tmp;++ STK_CHK_GEN(SIZEOF_MP_INT, R2_PTR, integer_cmm_testBitIntegerzh);+ MAYBE_GC(R2_PTR, integer_cmm_testBitIntegerzh);++ s = W_TO_INT(R1);+ d = R2;+ ul = R3;++ mp_tmp = Sp - 1 * SIZEOF_MP_INT;+ MP_INT__mp_alloc(mp_tmp) = W_TO_INT(BYTE_ARR_WDS(d));+ MP_INT__mp_size(mp_tmp) = (s);+ MP_INT__mp_d(mp_tmp) = BYTE_ARR_CTS(d);++ (res) = foreign "C" __gmpz_tstbit(mp_tmp "ptr", ul) [];++ RET_N(TO_W_(res));+}++integer_cmm_popCountIntegerzh+{+ CInt s, res;+ W_ d;+ W_ mp_tmp;++ STK_CHK_GEN(SIZEOF_MP_INT, R2_PTR, integer_cmm_popCountIntegerzh);+ MAYBE_GC(R2_PTR, integer_cmm_popCountIntegerzh);++ s = W_TO_INT(R1);+ d = R2;++ mp_tmp = Sp - 1 * SIZEOF_MP_INT;+ MP_INT__mp_alloc(mp_tmp) = W_TO_INT(BYTE_ARR_WDS(d));+ MP_INT__mp_size(mp_tmp) = (s);+ MP_INT__mp_d(mp_tmp) = BYTE_ARR_CTS(d);++ (res) = foreign "C" __gmpz_popcount(mp_tmp "ptr") [];++ RET_N(TO_W_(res));+}
src/Data/BitSet/Dynamic.hs view
@@ -1,7 +1,4 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-}-{-# LANGUAGE UnboxedTuples #-}-{-# LANGUAGE BangPatterns #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -----------------------------------------------------------------------------@@ -75,17 +72,12 @@ import Prelude hiding (null, map, filter, foldr) import Data.Bits (Bits(..))-import GHC.Base (Int(..), divInt#, modInt#)-import GHC.Exts (popCnt#)-import GHC.Integer.GMP.Internals (Integer(..))-import GHC.Prim (Int#, Word#,- (+#), (==#), (>=#), (<#), negateInt#,- word2Int#, int2Word#, plusWord#,- indexWordArray#)-import GHC.Word (Word(..))+import GHC.Base (Int(..)) import Control.DeepSeq (NFData(..)) +import GHC.Integer.GMP.TypeExt (popCountInteger, testBitInteger,+ setBitInteger, clearBitInteger) import Data.BitSet.Generic (GBitSet) import qualified Data.BitSet.Generic as GS @@ -115,16 +107,16 @@ bit = FasterInteger . bit {-# INLINE bit #-} - testBit (FasterInteger x) i = testBitInteger x i- {-# SPECIALIZE INLINE [1] testBit :: FasterInteger -> Int -> Bool #-}+ testBit (FasterInteger x) (I# i) = testBitInteger x i+ {-# SPECIALIZE INLINE testBit :: FasterInteger -> Int -> Bool #-} - setBit (FasterInteger x) = FasterInteger . setBit x+ setBit (FasterInteger x) (I# i) = FasterInteger $ setBitInteger x i {-# SPECIALIZE INLINE setBit :: FasterInteger -> Int -> FasterInteger #-} - clearBit (FasterInteger x) = FasterInteger . clearBit x+ clearBit (FasterInteger x) (I# i) = FasterInteger $ clearBitInteger x i {-# SPECIALIZE INLINE clearBit :: FasterInteger -> Int -> FasterInteger #-} - popCount (FasterInteger x) = I# (word2Int# (popCountInteger x))+ popCount (FasterInteger x) = I# (popCountInteger x) {-# SPECIALIZE INLINE popCount :: FasterInteger -> Int #-} bitSize = bitSize . unFI@@ -240,37 +232,3 @@ fromList :: Enum a => [a] -> BitSet a fromList = GS.fromList {-# INLINE fromList #-}--popCountInteger :: Integer -> Word#-popCountInteger (S# i#) = popCnt# (int2Word# i#)-popCountInteger (J# s# d#) = go 0# (int2Word# 0#) where- go i acc =- if i ==# s#- then acc- else go (i +# 1#) $ acc `plusWord#` popCnt# (indexWordArray# d# i)-{-# INLINE popCountInteger #-}--#include "MachDeps.h"-#ifndef WORD_SIZE_IN_BITS-#error WORD_SIZE_IN_BITS not defined!-#endif--divModInt# :: Int# -> Int# -> (# Int#, Int# #)-divModInt# x y = (# d, m #) where- !d = x `divInt#` y- !m = x `modInt#` y-{-# INLINE divModInt# #-}--abs# :: Int# -> Int#-abs# x = if x <# 0# then negateInt# x else x-{-# INLINE abs# #-}--testBitInteger :: Integer -> Int -> Bool-testBitInteger (S# i#) b = I# i# `testBit` b-testBitInteger (J# s# d#) (I# b#) =- if b# <# 0# || block# >=# abs# s#- then False- else W# (indexWordArray# d# block#) `testBit` I# offset#- where- (# !block#, !offset# #) = b# `divModInt#` WORD_SIZE_IN_BITS#-{-# NOINLINE testBitInteger #-}
src/Data/BitSet/Generic.hs view
@@ -256,7 +256,7 @@ -- | /O(d * n)/. Convert this bit set set to a list of elements. toList :: Num c => GBitSet c a -> [a]-toList bs = build (\f acc -> foldr f acc bs)+toList bs = build (\k z -> foldr k z bs) {-# INLINE toList #-} -- | /O(d * n)/. Make a bit set from a list of elements.
+ src/GHC/Integer/GMP/PrimExt.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE GHCForeignImportPrim #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnliftedFFITypes #-}+{-# LANGUAGE UnboxedTuples #-}++module GHC.Integer.GMP.PrimExt+ ( popCountInteger#+ , testBitInteger#+ , setBitInteger#+ , clearBitInteger#+ ) where++import GHC.Prim (Int#, ByteArray#)++foreign import prim "integer_cmm_popCountIntegerzh" popCountInteger#+ :: Int# -> ByteArray# -> Int#++foreign import prim "integer_cmm_testBitIntegerzh" testBitInteger#+ :: Int# -> ByteArray# -> Int# -> Int#++foreign import prim "integer_cmm_setBitIntegerzh" setBitInteger#+ :: Int# -> ByteArray# -> Int# -> (# Int#, ByteArray# #)++foreign import prim "integer_cmm_clearBitIntegerzh" clearBitInteger#+ :: Int# -> ByteArray# -> Int# -> (# Int#, ByteArray# #)
+ src/GHC/Integer/GMP/TypeExt.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE BangPatterns #-}++module GHC.Integer.GMP.TypeExt+ ( popCountInteger+ , testBitInteger+ , setBitInteger+ , clearBitInteger+ ) where++import Data.Bits (popCount, testBit, clearBit)+import GHC.Base (Int(..))+import GHC.Integer.GMP.Internals (Integer(..))+import GHC.Integer.GMP.Prim (int2Integer#)+import GHC.Prim (Int#, (/=#))++import GHC.Integer.GMP.PrimExt (popCountInteger#, testBitInteger#,+ setBitInteger#, clearBitInteger#)++popCountInteger :: Integer -> Int#+popCountInteger (S# i) = let !(I# n) = popCount (I# i) in n+popCountInteger (J# s d) = popCountInteger# s d+{-# NOINLINE popCountInteger #-}++testBitInteger :: Integer -> Int# -> Bool+testBitInteger (S# j) i = testBit (I# j) (I# 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 (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 (J# s d) i =+ let !(# s', d' #) = clearBitInteger# s d i in J# s' d'+{-# NOINLINE clearBitInteger #-}