diff --git a/.gitignore b/.gitignore index ef1e00d..a8b3a06 100644 --- a/.gitignore +++ b/.gitignore @@ -1,10 +1,8 @@ cabal-dev dist +dist-newstyle .cabal-sandbox/ cabal.sandbox.config .stack-work/ *.hi *.o - -# This file will be autogenerated on 'cabal build'. -cbits/GmpDerivedConstants.h diff --git a/.travis.yml b/.travis.yml index d5fb479..1af7eb7 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,80 +1,146 @@ -# NB: don't set `language: haskell` here - -# See also https://github.com/hvr/multi-ghc-travis for more information - -# The following lines enable several GHC versions and/or HP versions -# to be tested; often it's enough to test only against the last -# release of a major GHC version. Setting HPVER implictly sets -# GHCVER. Omit lines with versions you don't need/want testing for. -env: - - GHCVER=7.6.3 - - GHCVER=7.8.2 - - HPVER=2013.2.0.0 - -# Note: the distinction between `before_install` and `install` is not -# important. +# This Travis job script has been generated by a script via +# +# haskell-ci 'bitset.cabal' '--output' '.travis.yml' +# +# To regenerate the script (for example after adjusting tested-with) run +# +# haskell-ci regenerate +# +# For more information, see https://github.com/haskell-CI/haskell-ci +# +# version: 0.13.20210530 +# +version: ~> 1.0 +language: c +os: linux +dist: bionic +git: + # whether to recursively clone submodules + submodules: false +cache: + directories: + - $HOME/.cabal/packages + - $HOME/.cabal/store + - $HOME/.hlint +before_cache: + - rm -fv $CABALHOME/packages/hackage.haskell.org/build-reports.log + # remove files that are regenerated by 'cabal update' + - rm -fv $CABALHOME/packages/hackage.haskell.org/00-index.* + - rm -fv $CABALHOME/packages/hackage.haskell.org/*.json + - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.cache + - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar + - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar.idx + - rm -rfv $CABALHOME/packages/head.hackage +jobs: + include: + - compiler: ghc-8.10.4 + addons: {"apt":{"packages":["ghc-8.10.4","cabal-install-3.4"],"sources":[{"key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286","sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu bionic main"}]}} + os: linux + - compiler: ghc-8.8.4 + addons: {"apt":{"packages":["ghc-8.8.4","cabal-install-3.4"],"sources":[{"key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286","sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu bionic main"}]}} + os: linux + - compiler: ghc-8.6.5 + addons: {"apt":{"packages":["ghc-8.6.5","cabal-install-3.4"],"sources":[{"key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286","sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu bionic main"}]}} + os: linux + - compiler: ghc-8.4.4 + addons: {"apt":{"packages":["ghc-8.4.4","cabal-install-3.4"],"sources":[{"key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286","sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu bionic main"}]}} + os: linux before_install: - - case "$HPVER" in - "") ;; - - "2013.2.0.0") - export GHCVER=7.6.3 ; - echo "constraints:async==2.0.1.4,attoparsec==0.10.4.0,case-insensitive==1.0.0.1,cgi==3001.1.7.5,fgl==5.4.2.4,GLUT==2.4.0.0,GLURaw==1.3.0.0,haskell-src==1.0.1.5,hashable==1.1.2.5,html==1.0.1.2,HTTP==4000.2.8,HUnit==1.2.5.2,mtl==2.1.2,network==2.4.1.2,OpenGL==2.8.0.0,OpenGLRaw==1.3.0.0,parallel==3.2.0.3,parsec==3.1.3,random==1.0.1.1,regex-base==0.93.2,regex-compat==0.95.1,regex-posix==0.95.2,split==0.2.2,stm==2.4.2,syb==0.4.0,text==0.11.3.1,transformers==0.3.0.0,unordered-containers==0.2.3.0,vector==0.10.0.1,xhtml==3000.2.1,zlib==0.5.4.1" > cabal.config ;; - - "2012.4.0.0") - export GHCVER=7.6.2 ; - echo "constraints:async==2.0.1.3,cgi==3001.1.7.4,fgl==5.4.2.4,GLUT==2.1.2.1,haskell-src==1.0.1.5,html==1.0.1.2,HTTP==4000.2.5,HUnit==1.2.5.1,mtl==2.1.2,network==2.3.1.0,OpenGL==2.2.3.1,parallel==3.2.0.3,parsec==3.1.3,QuickCheck==2.5.1.1,random==1.0.1.1,regex-base==0.93.2,regex-compat==0.95.1,regex-posix==0.95.2,split==0.2.1.1,stm==2.4,syb==0.3.7,text==0.11.2.3,transformers==0.3.0.0,vector==0.10.0.1,xhtml==3000.2.1,zlib==0.5.4.0" > cabal.config ;; - - "2012.2.0.0") - export GHCVER=7.4.1 ; - echo "constraints:cgi==3001.1.7.4,fgl==5.4.2.4,GLUT==2.1.2.1,haskell-src==1.0.1.5,html==1.0.1.2,HTTP==4000.2.3,HUnit==1.2.4.2,mtl==2.1.1,network==2.3.0.13,OpenGL==2.2.3.1,parallel==3.2.0.2,parsec==3.1.2,QuickCheck==2.4.2,random==1.0.1.1,regex-base==0.93.2,regex-compat==0.95.1,regex-posix==0.95.1,stm==2.3,syb==0.3.6.1,text==0.11.2.0,transformers==0.3.0.0,xhtml==3000.2.1,zlib==0.5.3.3" > cabal.config ;; - - "2011.4.0.0") - export GHCVER=7.0.4 ; - echo "constraints:cgi==3001.1.7.4,fgl==5.4.2.4,GLUT==2.1.2.1,haskell-src==1.0.1.4,html==1.0.1.2,HUnit==1.2.4.2,network==2.3.0.5,OpenGL==2.2.3.0,parallel==3.1.0.1,parsec==3.1.1,QuickCheck==2.4.1.1,regex-base==0.93.2,regex-compat==0.95.1,regex-posix==0.95.1,stm==2.2.0.1,syb==0.3.3,xhtml==3000.2.0.4,zlib==0.5.3.1,HTTP==4000.1.2,deepseq==1.1.0.2" > cabal.config ;; - - *) - export GHCVER=unknown ; - echo "unknown/invalid Haskell Platform requested" ; - exit 1 ;; - - esac - - - sudo add-apt-repository -y ppa:hvr/ghc - - sudo apt-get update - - sudo apt-get install cabal-install-1.18 ghc-$GHCVER - - export PATH=/opt/ghc/$GHCVER/bin:~/.cabal/bin:$PATH - + - HC=$(echo "/opt/$CC/bin/ghc" | sed 's/-/\//') + - WITHCOMPILER="-w $HC" + - HADDOCK=$(echo "/opt/$CC/bin/haddock" | sed 's/-/\//') + - HCPKG="$HC-pkg" + - unset CC + - CABAL=/opt/ghc/bin/cabal + - CABALHOME=$HOME/.cabal + - export PATH="$CABALHOME/bin:$PATH" + - TOP=$(pwd) + - "HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\\d+)\\.(\\d+)\\.(\\d+)(\\.(\\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')" + - echo $HCNUMVER + - CABAL="$CABAL -vnormal+nowrap" + - set -o pipefail + - TEST=--enable-tests + - BENCH=--enable-benchmarks + - HEADHACKAGE=false + - rm -f $CABALHOME/config + - | + echo "verbose: normal +nowrap +markoutput" >> $CABALHOME/config + echo "remote-build-reporting: anonymous" >> $CABALHOME/config + echo "write-ghc-environment-files: never" >> $CABALHOME/config + echo "remote-repo-cache: $CABALHOME/packages" >> $CABALHOME/config + echo "logs-dir: $CABALHOME/logs" >> $CABALHOME/config + echo "world-file: $CABALHOME/world" >> $CABALHOME/config + echo "extra-prog-path: $CABALHOME/bin" >> $CABALHOME/config + echo "symlink-bindir: $CABALHOME/bin" >> $CABALHOME/config + echo "installdir: $CABALHOME/bin" >> $CABALHOME/config + echo "build-summary: $CABALHOME/logs/build.log" >> $CABALHOME/config + echo "store-dir: $CABALHOME/store" >> $CABALHOME/config + echo "install-dirs user" >> $CABALHOME/config + echo " prefix: $CABALHOME" >> $CABALHOME/config + echo "repository hackage.haskell.org" >> $CABALHOME/config + echo " url: http://hackage.haskell.org/" >> $CABALHOME/config install: - - cabal-1.18 update - - cabal-1.18 install --only-dependencies --enable-tests --enable-benchmarks - -# Here starts the actual work to be performed for the package under -# test; any command which exits with a non-zero exit code causes the -# build to fail. + - ${CABAL} --version + - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]" + - | + echo "program-default-options" >> $CABALHOME/config + echo " ghc-options: $GHCJOBS +RTS -M6G -RTS" >> $CABALHOME/config + - cat $CABALHOME/config + - rm -fv cabal.project cabal.project.local cabal.project.freeze + - travis_retry ${CABAL} v2-update -v + # Generate cabal.project + - rm -rf cabal.project cabal.project.local cabal.project.freeze + - touch cabal.project + - | + echo "packages: ." >> cabal.project + - echo 'package bitset' >> cabal.project + - "echo ' ghc-options: -Werror=missing-methods' >> cabal.project" + - "" + - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(bitset)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" + - cat cabal.project || true + - cat cabal.project.local || true + - if [ -f "./configure.ac" ]; then (cd "." && autoreconf -i); fi + - ${CABAL} v2-freeze $WITHCOMPILER ${TEST} ${BENCH} + - "cat cabal.project.freeze | sed -E 's/^(constraints: *| *)//' | sed 's/any.//'" + - rm cabal.project.freeze + - travis_wait 40 ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} --dep -j2 all + - travis_wait 40 ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks --dep -j2 all script: - # -v2 provides useful information for debugging - - cabal-1.18 configure --enable-tests --enable-benchmarks -v2 - - # this builds all libraries and executables - # (including tests/benchmarks) - - cabal-1.18 build - - - run-cabal-test --cabal-name=cabal-1.18 --show-details=always - - - cabal-1.18 check - - # tests that a source-distribution can be generated - - cabal-1.18 sdist - - # check that the generated source-distribution can be built & installed - - export SRC_TGZ=$(cabal-1.18 info . | awk '{print $2 ".tar.gz";exit}') ; - cd dist/; - if [ -f "$SRC_TGZ" ]; then - cabal-1.18 install "$SRC_TGZ"; - else - echo "expected '$SRC_TGZ' not found"; - exit 1; - fi - + - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX) + # Packaging... + - ${CABAL} v2-sdist all + # Unpacking... + - mv dist-newstyle/sdist/*.tar.gz ${DISTDIR}/ + - cd ${DISTDIR} || false + - find . -maxdepth 1 -type f -name '*.tar.gz' -exec tar -xvf '{}' \; + - find . -maxdepth 1 -type f -name '*.tar.gz' -exec rm '{}' \; + - PKGDIR_bitset="$(find . -maxdepth 1 -type d -regex '.*/bitset-[0-9.]*')" + # Generate cabal.project + - rm -rf cabal.project cabal.project.local cabal.project.freeze + - touch cabal.project + - | + echo "packages: ${PKGDIR_bitset}" >> cabal.project + - echo 'package bitset' >> cabal.project + - "echo ' ghc-options: -Werror=missing-methods' >> cabal.project" + - "" + - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(bitset)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" + - cat cabal.project || true + - cat cabal.project.local || true + # Building... + # this builds all libraries and executables (without tests/benchmarks) + - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all + # Building with tests and benchmarks... + # build & run tests, build benchmarks + - ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} all --write-ghc-environment-files=always + # Testing... + - ${CABAL} v2-test $WITHCOMPILER ${TEST} ${BENCH} all --test-show-details=direct + # cabal check... + - (cd ${PKGDIR_bitset} && ${CABAL} -vnormal check) + # haddock... + - ${CABAL} v2-haddock $WITHCOMPILER --with-haddock $HADDOCK ${TEST} ${BENCH} all + # Building without installed constraints for packages in global-db... + - rm -f cabal.project.local + - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all + +# REGENDATA ("0.13.20210530",["bitset.cabal","--output",".travis.yml"]) # EOF diff --git a/Setup.hs b/Setup.hs deleted file mode 100755 index bff99df..0000000 --- a/Setup.hs +++ /dev/null @@ -1,57 +0,0 @@ -#!/usr/bin/env runhaskell - -{-# LANGUAGE NamedFieldPuns #-} -{-# OPTIONS_GHC -Wall #-} - -import Control.Monad (when) -import System.Directory (doesFileExist, 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, CleanFlags) -import Distribution.Simple.Utils (die, rawSystemStdout) -import Distribution.System (OS(..), buildOS) -import Distribution.Verbosity (silent) - -main :: IO () -main = defaultMainWithHooks - simpleUserHooks { buildHook = mkDerivedGmpConstants, - cleanHook = rmDerivedGmpConstants - } - where - mkDerivedGmpConstants :: PackageDescription - -> LocalBuildInfo - -> UserHooks - -> BuildFlags - -> IO () - mkDerivedGmpConstants pkg_descr lbi userHooks flags = - case lookupProgram gccProgram (withPrograms lbi) of - Just gcc -> - let path = "src" exeName in do - runProgram silent gcc - ["bin" "mkDerivedGmpConstants.c", "-o", path] - output <- rawSystemStdout silent path [] - writeFile ("cbits" "GmpDerivedConstants.h") output - 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" - - rmDerivedGmpConstants :: PackageDescription - -> () - -> UserHooks - -> CleanFlags - -> IO () - rmDerivedGmpConstants pkg_descr () userHooks flags = - let path = "cbits" "GmpDerivedConstants.h" in - doesFileExist path >>= \res -> do - when res $ removeFile path - cleanHook simpleUserHooks pkg_descr () userHooks flags diff --git a/bin/mkDerivedGmpConstants.c b/bin/mkDerivedGmpConstants.c deleted file mode 100644 index d97e97e..0000000 --- a/bin/mkDerivedGmpConstants.c +++ /dev/null @@ -1,73 +0,0 @@ -/* -------------------------------------------------------------------------- - * - * (c) The GHC Team, 1992-2004 - * - * mkDerivedConstants.c - * - * Basically this is a C program that extracts information from the C - * declarations in the header files (primarily struct field offsets) - * and generates a header file that can be #included into non-C source - * containing this information. - * - * ------------------------------------------------------------------------*/ - -#include -#include - - -#define str(a,b) #a "_" #b - -#define OFFSET(s_type, field) ((size_t)&(((s_type*)0)->field)) - -/* struct_size(TYPE) - * - */ -#define def_size(str, size) \ - printf("#define SIZEOF_" str " %lu\n", (unsigned long)size); - -#define struct_size(s_type) \ - def_size(#s_type, sizeof(s_type)); - - - -/* struct_field(TYPE, FIELD) - * - */ -#define def_offset(str, offset) \ - printf("#define OFFSET_" str " %d\n", (int)(offset)); - -#define field_offset_(str, s_type, field) \ - def_offset(str, OFFSET(s_type,field)); - -#define field_offset(s_type, field) \ - field_offset_(str(s_type,field),s_type,field); - -#define field_type_(str, s_type, field) \ - printf("#define REP_" str " b"); \ - printf("%lu\n", (unsigned long)sizeof (__typeof__(((((s_type*)0)->field)))) * 8); - -#define field_type(s_type, field) \ - field_type_(str(s_type,field),s_type,field); - -/* An access macro for use in C-- sources. */ -#define struct_field_macro(str) \ - printf("#define " str "(__ptr__) REP_" str "[__ptr__+OFFSET_" str "]\n"); - -/* Outputs the byte offset and MachRep for a field */ -#define struct_field(s_type, field) \ - field_offset(s_type, field); \ - field_type(s_type, field); \ - struct_field_macro(str(s_type,field)) - - -int main(void) -{ - printf("/* This file is created automatically. Do not edit by hand.*/\n\n"); - - struct_size(MP_INT); - struct_field(MP_INT,_mp_alloc); - struct_field(MP_INT,_mp_size); - struct_field(MP_INT,_mp_d); - - return 0; -} diff --git a/bitset.cabal b/bitset.cabal index b27fe09..82a7caa 100644 --- a/bitset.cabal +++ b/bitset.cabal @@ -1,5 +1,6 @@ +Cabal-Version: 2.2 Name: bitset -Version: 1.4.8 +Version: 1.5.0 Synopsis: A space-efficient set data structure. Description: A /bit set/ is a compact data structure, which maintains a set of members @@ -14,36 +15,27 @@ Author: Sergei Lebedev Maintainer: superbobry@gmail.com Bug-reports: http://github.com/lambda-llama/bitset/issues Stability: Experimental -Cabal-Version: >= 1.12 -Build-type: Custom -Tested-with: GHC == 7.4.1, GHC == 7.6.3, GHC == 7.8.4 -Extra-Source-Files: bin/mkDerivedGmpConstants.c, include/bitset.h +Tested-with: GHC == 8.4.4, GHC == 8.6.5, GHC == 8.8.4, GHC == 8.10.4 Source-repository head Type: git Location: https://github.com/lambda-llama/bitset -Library - Hs-source-dirs: src +Common common-options Ghc-options: -Wall -fno-warn-orphans Default-language: Haskell2010 - Other-extensions: CPP, NamedFieldPuns, MagicHash, UnboxedTuples, - BangPatterns, ForeignFunctionInterface, - GHCForeignImportPrim, MagicHash, - UnliftedFFITypes, UnboxedTuples, + Default-extensions: CPP, NamedFieldPuns, MagicHash, UnboxedTuples, + BangPatterns, MagicHash, UnboxedTuples, GeneralizedNewtypeDeriving, TypeFamilies, DeriveDataTypeable - C-sources: cbits/gmp-extras.cmm - Include-dirs: cbits, include - - if os(windows) - Extra-libraries: gmp-10 - else - Extra-libraries: gmp + Build-depends: base >= 4.8.0 && < 5.0 - Build-depends: base >= 4.4.0 && < 4.8 - , deepseq +Library + Import: common-options + Hs-source-dirs: src + + Build-depends: deepseq , integer-gmp , ghc-prim @@ -51,42 +43,28 @@ Library , Data.BitSet.Dynamic , Data.BitSet.Generic , Data.BitSet.Word - Other-modules: GHC.Integer.GMP.PrimExt - , GHC.Integer.GMP.TypeExt Test-suite bitset-tests + Import: common-options 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 - Build-depends: base + Build-depends: bitset , QuickCheck , tasty , tasty-quickcheck - , bitset 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 - Extra-libraries: gmp + Import: common-options + Hs-source-dirs: benchmarks Type: exitcode-stdio-1.0 Main-is: Benchmarks.hs - Build-depends: base + Build-depends: bitset , deepseq - , integer-gmp - , ghc-prim - , criterion , containers , random diff --git a/cbits/gmp-extras.cmm b/cbits/gmp-extras.cmm deleted file mode 100644 index 6841dd9..0000000 --- a/cbits/gmp-extras.cmm +++ /dev/null @@ -1,149 +0,0 @@ -#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_setbit; -import "integer-gmp" __gmpz_clrbit; - -#if __GLASGOW_HASKELL__ >= 707 - -#define GMP_TAKE1_UL1_RET1(name,mp_fun) \ -name (W_ ws1, P_ d1, W_ wul) \ -{ \ - CInt s1; \ - CLong ul; \ - W_ mp_tmp; \ - W_ mp_result; \ - \ - /* call doYouWantToGC() */ \ -again: \ - STK_CHK_GEN_N (2 * SIZEOF_MP_INT); \ - MAYBE_GC(again); \ - \ - s1 = W_TO_INT(ws1); \ - ul = W_TO_LONG(wul); \ - \ - 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(d1)); \ - MP_INT__mp_size(mp_tmp) = (s1); \ - MP_INT__mp_d(mp_tmp) = BYTE_ARR_CTS(d1); \ - \ - ccall __gmpz_init_set(mp_result "ptr", mp_tmp "ptr"); \ - \ - /* Perform the operation */ \ - ccall mp_fun(mp_result "ptr", ul); \ - \ - return(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_popCountIntegerzh (W_ ws, W_ d) -{ - CInt s, res; - W_ mp_tmp; - -again: - STK_CHK_P_LL(SIZEOF_MP_INT, integer_cmm_popCountIntegerzh, R2); - MAYBE_GC(again); - - s = W_TO_INT(ws); - - 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"); - - return (TO_W_(res)); -} -#else - -#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)); -} -#endif \ No newline at end of file diff --git a/include/bitset.h b/include/bitset.h deleted file mode 100644 index de7f8b2..0000000 --- a/include/bitset.h +++ /dev/null @@ -1,39 +0,0 @@ -/* - * 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 diff --git a/src/Data/BitSet/Dynamic.hs b/src/Data/BitSet/Dynamic.hs index f4b16a0..2db62c0 100644 --- a/src/Data/BitSet/Dynamic.hs +++ b/src/Data/BitSet/Dynamic.hs @@ -1,9 +1,3 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE MagicHash #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} - -#include - ----------------------------------------------------------------------------- -- | -- Module : Data.BitSet.Dynamic @@ -75,61 +69,15 @@ module Data.BitSet.Dynamic import Prelude hiding (null, map, filter, foldr) import Data.Bits (Bits(..)) -import GHC.Base (Int(..)) import Control.DeepSeq (NFData(..)) -import GHC.Integer.GMP.TypeExt (popCountInteger, testBitInteger, - setBitInteger, clearBitInteger) import qualified Data.BitSet.Generic as GS + -- | A wrapper around 'Integer' which provides faster bit-level operations. newtype FasterInteger = FasterInteger { unFI :: Integer } - deriving (Read, Show, Eq, Ord, Enum, Integral, Num, Real, NFData) - -instance Bits FasterInteger where - FasterInteger x .&. FasterInteger y = FasterInteger $ x .&. y - {-# INLINE (.&.) #-} - - FasterInteger x .|. FasterInteger y = FasterInteger $ x .|. y - {-# INLINE (.|.) #-} - - FasterInteger x `xor` FasterInteger y = FasterInteger $ x `xor` y - {-# INLINE xor #-} - - complement = FasterInteger . complement . unFI - {-# INLINE complement #-} - - shift (FasterInteger x) = FasterInteger . shift x - {-# INLINE shift #-} - - rotate (FasterInteger x) = FasterInteger . rotate x - {-# INLINE rotate #-} - - bit = FasterInteger . bit - {-# INLINE bit #-} - - testBit (FasterInteger x) (I# i) = testBitInteger x i - {-# SPECIALIZE INLINE testBit :: FasterInteger -> Int -> Bool #-} - - setBit (FasterInteger x) (I# i) = FasterInteger $ setBitInteger x i - {-# SPECIALIZE INLINE setBit :: FasterInteger -> Int -> FasterInteger #-} - - clearBit (FasterInteger x) (I# i) = FasterInteger $ clearBitInteger x i - {-# SPECIALIZE INLINE clearBit :: FasterInteger -> Int -> FasterInteger #-} - - popCount (FasterInteger x) = I# (popCountInteger x) - {-# SPECIALIZE INLINE popCount :: FasterInteger -> Int #-} - - isSigned = isSigned . unFI - {-# INLINE isSigned #-} - - bitSize _ = error "bitSize: FasterInteger does not support bitSize." - -#if MIN_VERSION_base(4,7,0) - bitSizeMaybe _ = Nothing - {-# INLINE bitSizeMaybe #-} -#endif + deriving (Read, Show, Eq, Ord, Enum, Integral, Num, Real, NFData, Bits) type BitSet = GS.BitSet FasterInteger diff --git a/src/Data/BitSet/Generic.hs b/src/Data/BitSet/Generic.hs index 90cfedb..797f7c7 100644 --- a/src/Data/BitSet/Generic.hs +++ b/src/Data/BitSet/Generic.hs @@ -25,14 +25,6 @@ -- independent of container choice, the maximum number of elements in a -- bit set is bounded by @maxBound :: Int@. -{-# LANGUAGE CPP #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} - -#include - module Data.BitSet.Generic ( -- * Bit set type @@ -77,21 +69,15 @@ module Data.BitSet.Generic import Prelude hiding (null, map, filter, foldr) -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.Bits (Bits, (.|.), (.&.), complement, + bit, testBit, setBit, clearBit, + popCount, bitSizeMaybe, isSigned, + unsafeShiftR, zeroBits) import Data.Data (Typeable) -import Data.Monoid (Monoid(..)) import Foreign (Storable) -import GHC.Exts (build) -#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 707) -import GHC.Exts (IsList) +import GHC.Exts (build, IsList) import qualified GHC.Exts as Exts -#endif import Text.Read (Read(..), Lexeme(..), lexP, prec, parens) import qualified Data.List as List @@ -108,22 +94,16 @@ instance (Enum a, Show a, Bits c) => Show (BitSet c a) where showsPrec p bs = showParen (p > 10) $ showString "fromList " . shows (toList bs) +instance Bits c => Semigroup (BitSet c a) where + (<>) = union + instance Bits c => Monoid (BitSet c a) where mempty = empty - mappend = union -#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 707) 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 :: Bits c => BitSet c a -> Bool @@ -206,7 +186,6 @@ 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 -#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 @@ -221,7 +200,7 @@ foldl' f acc0 (BitSet bits0) | 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 @@ -233,7 +212,6 @@ foldl' f acc0 (BitSet bits) = go acc0 (popCount bits) 0 -- | /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 @@ -241,7 +219,7 @@ foldr f acc0 (BitSet bits0) | 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 diff --git a/src/Data/BitSet/Word.hs b/src/Data/BitSet/Word.hs index 6a016d7..c5649cc 100644 --- a/src/Data/BitSet/Word.hs +++ b/src/Data/BitSet/Word.hs @@ -70,8 +70,6 @@ module Data.BitSet.Word import Prelude hiding (null, map, filter, foldr) -import Data.Word (Word) - import qualified Data.BitSet.Generic as GS type BitSet = GS.BitSet Word diff --git a/src/GHC/Integer/GMP/PrimExt.hs b/src/GHC/Integer/GMP/PrimExt.hs deleted file mode 100644 index f9e7c3c..0000000 --- a/src/GHC/Integer/GMP/PrimExt.hs +++ /dev/null @@ -1,26 +0,0 @@ -{-# 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# #) diff --git a/src/GHC/Integer/GMP/TypeExt.hs b/src/GHC/Integer/GMP/TypeExt.hs deleted file mode 100644 index fb3014d..0000000 --- a/src/GHC/Integer/GMP/TypeExt.hs +++ /dev/null @@ -1,68 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE MagicHash #-} -{-# LANGUAGE UnboxedTuples #-} -{-# LANGUAGE BangPatterns #-} - -module GHC.Integer.GMP.TypeExt - ( popCountInteger - , testBitInteger - , setBitInteger - , clearBitInteger - ) where - -#include "MachDeps.h" - -import GHC.Integer.GMP.Internals (Integer(..)) -import GHC.Integer.GMP.Prim (int2Integer#) -import GHC.Prim (Int#, (/=#), (>=#), (<#), (-#), - int2Word#, word2Int#, popCnt#, - negateInt#, and#, or#, xor#, uncheckedIShiftL#) - -import GHC.Integer.GMP.PrimExt (popCountInteger#, testBitInteger#, - setBitInteger#, clearBitInteger#) - -#if __GLASGOW_HASKELL__ >= 707 -import GHC.Exts (isTrue#) -#else -isTrue# = id -#endif - -popCountInteger :: Integer -> Int# -popCountInteger (S# i) = word2Int# (popCnt# (int2Word# i)) -popCountInteger (J# s d) = popCountInteger# s d -{-# NOINLINE popCountInteger #-} - -testBitInteger :: Integer -> Int# -> Bool -testBitInteger (S# j) i - | isTrue# (i <# 0#) = False - | isTrue# (i <# (WORD_SIZE_IN_BITS# -# 1#)) = - let !mask = 1# `uncheckedIShiftL#` i in - isTrue# (word2Int# (int2Word# j `and#` int2Word# mask) /=# 0#) - | otherwise = - let !(# s, d #) = int2Integer# j in testBitInteger (J# s d) i -testBitInteger (J# s d) i = isTrue# (testBitInteger# s d i /=# 0#) -{-# NOINLINE testBitInteger #-} - -setBitInteger :: Integer -> Int# -> Integer -setBitInteger (S# j) i - | isTrue# (i <# 0#) = S# j - | isTrue# (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 - | isTrue# (i <# 0#) || isTrue# (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 #-} \ No newline at end of file diff --git a/tests/Tests.hs b/tests/Tests.hs index 74d7feb..80f43af 100644 --- a/tests/Tests.hs +++ b/tests/Tests.hs @@ -2,12 +2,10 @@ module Main (main) where -import Control.Applicative ((<$>)) import Data.Bits (Bits, popCount, testBit, setBit, clearBit) import Data.Int (Int16) import Data.List ((\\), intersect, union, nub, sort) -import Data.Monoid ((<>), mempty) -import Data.Word (Word, Word16) +import Data.Word (Word16) import Foreign (Storable(..), allocaBytes) import Test.Tasty (TestTree, testGroup, defaultMain)