├── .gitignore ├── .travis.yml ├── CHANGES ├── LICENSE ├── README.md ├── Setup.hs ├── benchmarks └── Benchmarks.hs ├── bin └── mkDerivedGmpConstants.c ├── bitset.cabal ├── cbits └── gmp-extras.cmm ├── include └── bitset.h ├── src ├── Data │ ├── BitSet.hs │ └── BitSet │ │ ├── Dynamic.hs │ │ ├── Generic.hs │ │ └── Word.hs └── GHC │ └── Integer │ └── GMP │ ├── PrimExt.hs │ └── TypeExt.hs ├── tests └── Tests.hs └── travis.sh /.gitignore: -------------------------------------------------------------------------------- 1 | cabal-dev 2 | dist 3 | .cabal-sandbox/ 4 | cabal.sandbox.config 5 | .stack-work/ 6 | *.hi 7 | *.o 8 | 9 | # This file will be autogenerated on 'cabal build'. 10 | cbits/GmpDerivedConstants.h 11 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | # NB: don't set `language: haskell` here 2 | 3 | # See also https://github.com/hvr/multi-ghc-travis for more information 4 | 5 | # The following lines enable several GHC versions and/or HP versions 6 | # to be tested; often it's enough to test only against the last 7 | # release of a major GHC version. Setting HPVER implictly sets 8 | # GHCVER. Omit lines with versions you don't need/want testing for. 9 | env: 10 | - GHCVER=7.6.3 11 | - GHCVER=7.8.2 12 | - HPVER=2013.2.0.0 13 | 14 | # Note: the distinction between `before_install` and `install` is not 15 | # important. 16 | before_install: 17 | - case "$HPVER" in 18 | "") ;; 19 | 20 | "2013.2.0.0") 21 | export GHCVER=7.6.3 ; 22 | 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 ;; 23 | 24 | "2012.4.0.0") 25 | export GHCVER=7.6.2 ; 26 | 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 ;; 27 | 28 | "2012.2.0.0") 29 | export GHCVER=7.4.1 ; 30 | 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 ;; 31 | 32 | "2011.4.0.0") 33 | export GHCVER=7.0.4 ; 34 | 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 ;; 35 | 36 | *) 37 | export GHCVER=unknown ; 38 | echo "unknown/invalid Haskell Platform requested" ; 39 | exit 1 ;; 40 | 41 | esac 42 | 43 | - sudo add-apt-repository -y ppa:hvr/ghc 44 | - sudo apt-get update 45 | - sudo apt-get install cabal-install-1.18 ghc-$GHCVER 46 | - export PATH=/opt/ghc/$GHCVER/bin:~/.cabal/bin:$PATH 47 | 48 | install: 49 | - cabal-1.18 update 50 | - cabal-1.18 install --only-dependencies --enable-tests --enable-benchmarks 51 | 52 | # Here starts the actual work to be performed for the package under 53 | # test; any command which exits with a non-zero exit code causes the 54 | # build to fail. 55 | script: 56 | # -v2 provides useful information for debugging 57 | - cabal-1.18 configure --enable-tests --enable-benchmarks -v2 58 | 59 | # this builds all libraries and executables 60 | # (including tests/benchmarks) 61 | - cabal-1.18 build 62 | 63 | - run-cabal-test --cabal-name=cabal-1.18 --show-details=always 64 | 65 | - cabal-1.18 check 66 | 67 | # tests that a source-distribution can be generated 68 | - cabal-1.18 sdist 69 | 70 | # check that the generated source-distribution can be built & installed 71 | - export SRC_TGZ=$(cabal-1.18 info . | awk '{print $2 ".tar.gz";exit}') ; 72 | cd dist/; 73 | if [ -f "$SRC_TGZ" ]; then 74 | cabal-1.18 install "$SRC_TGZ"; 75 | else 76 | echo "expected '$SRC_TGZ' not found"; 77 | exit 1; 78 | fi 79 | 80 | # EOF 81 | -------------------------------------------------------------------------------- /CHANGES: -------------------------------------------------------------------------------- 1 | bitset Changelog 2 | ================ 3 | 4 | Here you can see the full list of changes between each bitset release. 5 | 6 | Version 1.4.8 7 | 8 | - Add support for GHC 7.8 9 | - IsList instance for BitSet, so it's possible to use OverloadedLists extension. 10 | 11 | Version 1.4.7 12 | ------------- 13 | 14 | Released on August 25th, 2013 15 | 16 | - 'GBitSet' was renamed to 'BitSet' and is now 'newtype' as suggested 17 | by John Ericson, see #10 on GitHub for details. 18 | 19 | Version 1.4.6 20 | ------------- 21 | 22 | Released on July 17th, 2013 23 | 24 | - Fixed build issues on Windows, see #9 on GitHub for details. 25 | 26 | Version 1.4.5 27 | ------------- 28 | 29 | Released on June 6th, 2013 30 | 31 | - Fixed 'Ord' instance, same bug as in 'Eq'. Where is my mind? 32 | 33 | Version 1.4.4 34 | ------------- 35 | 36 | Released on May 14th, 2013 37 | 38 | - Fixed 'Eq' instance, equal sizes don't mean a thing! 39 | 40 | Version 1.4.3 41 | ------------- 42 | 43 | Released on May 13th, 2013 44 | 45 | - Fixed bug with broken cabal distribution. 46 | 47 | Version 1.4.2 48 | ------------- 49 | 50 | - Switched to GMP bit fiddling functions, the corresponding patch for 51 | 'integer-gmp' was submitted to GHC, see 52 | http://hackage.haskell.org/trac/ghc/ticket/7860 53 | 54 | Version 1.4.1 55 | ------------- 56 | 57 | Released on April 24th, 2013 58 | 59 | - Removed 'clearBitInteger' which didn't update the size field of 60 | the newly created 'Integer'. Turns out it's completely non-trivial 61 | to implement. 62 | 63 | 64 | Version 1.4.0 65 | ------------- 66 | 67 | Released on April 4th, 2013 68 | 69 | - More speed optimizations, 'Data.BitSet.Dynamic' is close to 'Data.Set' 70 | performance on most operations. 71 | - Added 'Data.BitSet.Word', a bit set with native integer as container 72 | type, significantly faster then 'Data.Set' for enumerated types with 73 | small number of constructors. 74 | - Added folds, 'map' and 'filter' for consistency with other Haskell 75 | containers. 76 | 77 | Version 1.3.0 78 | ------------- 79 | 80 | Released on March 25th, 2013 81 | 82 | - Added a generic bit set data type, abstract with respect to the underlying 83 | container. 84 | - Improved dynamic bit set performance via optimized 'popCount' and 85 | 'testBit' functions. 86 | 87 | Version 1.2 88 | ----------- 89 | 90 | Initial release, released on March 22th, 2013 91 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2013 Sergei Lebedev, Aleksey Kladov 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining a copy of this software and 4 | associated documentation files (the "Software"), to deal in the Software without restriction, 5 | including without limitation the rights to use, copy, modify, merge, publish, distribute, 6 | sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is 7 | furnished to do so, subject to the following conditions: 8 | 9 | The above copyright notice and this permission notice shall be included in all copies or substantial 10 | portions of the Software. 11 | 12 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT 13 | NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 14 | NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES 15 | OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN 16 | CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 17 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | bitset [![Build Status][travis-img]][travis] 2 | ====== 3 | 4 | A _bit set_ is a compact data structure, which maintains a set of members 5 | from a type that can be enumerated (i. e. has an `Enum` instance). Current 6 | implementation is abstract with respect to conatiner type, so any 7 | numeric type with `Bits` instance can be used as a container. 8 | 9 | Here's a usage example for a dynamic bit set, which uses a tweaked version 10 | of `Integer` for storing bits: 11 | 12 | ```haskell 13 | import Data.BitSet (BitSet, (\\)) 14 | import qualified Data.BitSet as BitSet 15 | 16 | data Color = Red | Green | Blue deriving (Show, Enum) 17 | 18 | main :: IO () 19 | main = print $ bs \\ BitSet.singleton Blue where 20 | bs :: BitSet Color 21 | bs = BitSet.fromList [Red, Green, Blue] 22 | ``` 23 | 24 | The API is exactly the same for a static bitset, based on native `Word`. 25 | Here's an example from [`hen`] [hen] library, which uses `Data.BitSet` to 26 | store Xen domain status flags: 27 | 28 | ```haskell 29 | import qualified Data.BitSet.Word as BS 30 | 31 | data DomainFlag = Dying 32 | | Crashed 33 | | Shutdown 34 | | Paused 35 | | Blocked 36 | | Running 37 | | HVM 38 | | Debugged 39 | deriving (Enum, Show) 40 | 41 | isAlive :: DomainFlag -> Bool 42 | isAlive = not . BS.null . BS.intersect (BS.fromList [Crashed, Shutdown]) 43 | ``` 44 | 45 | Benchmarks 46 | ---------- 47 | 48 | To run benchmarks, configure `cabal` with benchmarks 49 | and build: 50 | 51 | ```bash 52 | $ cabal-dev install-deps --enable-benchmarks && cabal-dev build 53 | $ ./dist/build/bitset-benchmarks/bitset-benchmarks -o dist/bench.html 54 | ``` 55 | 56 | [travis]: http://travis-ci.org/lambda-llama/bitset 57 | [travis-img]: https://secure.travis-ci.org/lambda-llama/bitset.png 58 | [hen]: https://github.com/selectel/hen/ 59 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env runhaskell 2 | 3 | {-# LANGUAGE NamedFieldPuns #-} 4 | {-# OPTIONS_GHC -Wall #-} 5 | 6 | import Control.Monad (when) 7 | import System.Directory (doesFileExist, removeFile) 8 | import System.FilePath (()) 9 | 10 | import Distribution.PackageDescription (PackageDescription) 11 | import Distribution.Simple (UserHooks(..), 12 | defaultMainWithHooks, simpleUserHooks) 13 | import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..)) 14 | import Distribution.Simple.Program (gccProgram, lookupProgram, runProgram) 15 | import Distribution.Simple.Setup (BuildFlags, CleanFlags) 16 | import Distribution.Simple.Utils (die, rawSystemStdout) 17 | import Distribution.System (OS(..), buildOS) 18 | import Distribution.Verbosity (silent) 19 | 20 | main :: IO () 21 | main = defaultMainWithHooks 22 | simpleUserHooks { buildHook = mkDerivedGmpConstants, 23 | cleanHook = rmDerivedGmpConstants 24 | } 25 | where 26 | mkDerivedGmpConstants :: PackageDescription 27 | -> LocalBuildInfo 28 | -> UserHooks 29 | -> BuildFlags 30 | -> IO () 31 | mkDerivedGmpConstants pkg_descr lbi userHooks flags = 32 | case lookupProgram gccProgram (withPrograms lbi) of 33 | Just gcc -> 34 | let path = "src" exeName in do 35 | runProgram silent gcc 36 | ["bin" "mkDerivedGmpConstants.c", "-o", path] 37 | output <- rawSystemStdout silent path [] 38 | writeFile ("cbits" "GmpDerivedConstants.h") output 39 | removeFile path 40 | buildHook simpleUserHooks pkg_descr lbi userHooks flags 41 | Nothing -> die "Failed to find GCC!" 42 | where 43 | exeName :: FilePath 44 | exeName = case buildOS of 45 | Windows -> "mkDerivedGmpConstants.exe" 46 | _ -> "mkDerivedGmpConstants" 47 | 48 | rmDerivedGmpConstants :: PackageDescription 49 | -> () 50 | -> UserHooks 51 | -> CleanFlags 52 | -> IO () 53 | rmDerivedGmpConstants pkg_descr () userHooks flags = 54 | let path = "cbits" "GmpDerivedConstants.h" in 55 | doesFileExist path >>= \res -> do 56 | when res $ removeFile path 57 | cleanHook simpleUserHooks pkg_descr () userHooks flags 58 | -------------------------------------------------------------------------------- /benchmarks/Benchmarks.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ExistentialQuantification #-} 2 | 3 | module Main (main) where 4 | 5 | import Data.List (foldl') 6 | 7 | import Control.DeepSeq (NFData(..)) 8 | import Criterion.Main (defaultMain, bench, bgroup, whnf) 9 | import Data.Set (Set) 10 | import System.Random (mkStdGen) 11 | import System.Random.Shuffle (shuffle') 12 | import qualified Data.Set as Set 13 | 14 | import Data.BitSet (BitSet) 15 | import qualified Data.BitSet as BS 16 | 17 | data B = forall a. NFData a => B a 18 | 19 | instance NFData B where 20 | rnf (B b) = rnf b 21 | 22 | main :: IO () 23 | main = do 24 | let bs1 = BS.fromList elems1 25 | bs2 = BS.fromList elems2 26 | s1 = Set.fromList elems1 27 | s2 = Set.fromList elems2 28 | r = mkStdGen 42 29 | shuffledElems1 = shuffle' elems1 n r 30 | shuffledElems2 = shuffle' elems2 (n `div` 2) r 31 | return $ rnf [B bs1, B bs2, B s1, B s2, B shuffledElems1, B shuffledElems2] 32 | defaultMain 33 | [ bgroup "Set" 34 | [ bench "fromList" (whnf Set.fromList shuffledElems1) 35 | , bench "toList" (whnf Set.toList s1) 36 | , bench "singleton" (whnf Set.singleton n) 37 | , bench "insert" (whnf (insertS elems1) Set.empty) 38 | , bench "delete" (whnf (deleteS elems1) s1) 39 | , bench "notMember" (whnf (notMemberS shuffledElems1) s1) 40 | , bench "member" (whnf (memberS shuffledElems1) s1) 41 | , bench "isSubsetOf" (whnf (Set.isSubsetOf s2) s1) 42 | , bench "isProperSubsetOf" (whnf (Set.isProperSubsetOf s2) s1) 43 | , bench "intersection" (whnf (Set.intersection s2) s1) 44 | , bench "difference" (whnf (Set.difference s2) s1) 45 | , bench "union" (whnf (Set.union s2) s1) 46 | , bench "map" (whnf (Set.map (+ n)) s1) 47 | , bench "filter" (whnf (Set.filter odd) s1) 48 | ] 49 | 50 | , bgroup "BitSet" 51 | [ bench "fromList" (whnf BS.fromList shuffledElems1) 52 | , bench "toList" (whnf BS.toList bs1) 53 | , bench "singleton" (whnf BS.singleton n) 54 | , bench "insert" (whnf (insertBS elems1) BS.empty) 55 | , bench "delete" (whnf (deleteBS elems1) bs1) 56 | , bench "notMember" (whnf (notMemberBS shuffledElems1) bs1) 57 | , bench "member" (whnf (memberBS shuffledElems1) bs1) 58 | , bench "isSubsetOf" (whnf (BS.isSubsetOf bs2) bs1) 59 | , bench "isProperSubsetOf" (whnf (BS.isProperSubsetOf bs2) bs1) 60 | , bench "intersection" (whnf (BS.intersection bs2) bs1) 61 | , bench "difference" (whnf (BS.difference bs2) bs1) 62 | , bench "union" (whnf (BS.union bs2) bs1) 63 | , bench "map" (whnf (BS.map (+ n)) bs1) 64 | , bench "filter" (whnf (BS.filter odd) bs1) 65 | ] 66 | ] 67 | where 68 | n :: Int 69 | n = 4096 70 | 71 | elems1 = [1..n] 72 | elems2 = [1..n `div` 2] 73 | 74 | memberS :: [Int] -> Set Int -> Bool 75 | memberS xs s = all (\x -> Set.member x s) xs 76 | 77 | memberBS :: [Int] -> BitSet Int -> Bool 78 | memberBS xs bs = all (\x -> BS.member x bs) xs 79 | 80 | notMemberS :: [Int] -> Set Int -> Bool 81 | notMemberS xs s = all (\x -> Set.notMember x s) xs 82 | 83 | notMemberBS :: [Int] -> BitSet Int -> Bool 84 | notMemberBS xs bs = all (\x -> BS.notMember x bs) xs 85 | 86 | insertS :: [Int] -> Set Int -> Set Int 87 | insertS xs s0 = foldl' (\s x -> Set.insert x s) s0 xs 88 | 89 | insertBS :: [Int] -> BitSet Int -> BitSet Int 90 | insertBS xs bs0 = foldl' (\bs x -> BS.insert x bs) bs0 xs 91 | 92 | deleteS :: [Int] -> Set Int -> Set Int 93 | deleteS xs s0 = foldl' (\s x -> Set.delete x s) s0 xs 94 | 95 | deleteBS :: [Int] -> BitSet Int -> BitSet Int 96 | deleteBS xs bs0 = foldl' (\bs x -> BS.delete x bs) bs0 xs 97 | -------------------------------------------------------------------------------- /bin/mkDerivedGmpConstants.c: -------------------------------------------------------------------------------- 1 | /* -------------------------------------------------------------------------- 2 | * 3 | * (c) The GHC Team, 1992-2004 4 | * 5 | * mkDerivedConstants.c 6 | * 7 | * Basically this is a C program that extracts information from the C 8 | * declarations in the header files (primarily struct field offsets) 9 | * and generates a header file that can be #included into non-C source 10 | * containing this information. 11 | * 12 | * ------------------------------------------------------------------------*/ 13 | 14 | #include 15 | #include 16 | 17 | 18 | #define str(a,b) #a "_" #b 19 | 20 | #define OFFSET(s_type, field) ((size_t)&(((s_type*)0)->field)) 21 | 22 | /* struct_size(TYPE) 23 | * 24 | */ 25 | #define def_size(str, size) \ 26 | printf("#define SIZEOF_" str " %lu\n", (unsigned long)size); 27 | 28 | #define struct_size(s_type) \ 29 | def_size(#s_type, sizeof(s_type)); 30 | 31 | 32 | 33 | /* struct_field(TYPE, FIELD) 34 | * 35 | */ 36 | #define def_offset(str, offset) \ 37 | printf("#define OFFSET_" str " %d\n", (int)(offset)); 38 | 39 | #define field_offset_(str, s_type, field) \ 40 | def_offset(str, OFFSET(s_type,field)); 41 | 42 | #define field_offset(s_type, field) \ 43 | field_offset_(str(s_type,field),s_type,field); 44 | 45 | #define field_type_(str, s_type, field) \ 46 | printf("#define REP_" str " b"); \ 47 | printf("%lu\n", (unsigned long)sizeof (__typeof__(((((s_type*)0)->field)))) * 8); 48 | 49 | #define field_type(s_type, field) \ 50 | field_type_(str(s_type,field),s_type,field); 51 | 52 | /* An access macro for use in C-- sources. */ 53 | #define struct_field_macro(str) \ 54 | printf("#define " str "(__ptr__) REP_" str "[__ptr__+OFFSET_" str "]\n"); 55 | 56 | /* Outputs the byte offset and MachRep for a field */ 57 | #define struct_field(s_type, field) \ 58 | field_offset(s_type, field); \ 59 | field_type(s_type, field); \ 60 | struct_field_macro(str(s_type,field)) 61 | 62 | 63 | int main(void) 64 | { 65 | printf("/* This file is created automatically. Do not edit by hand.*/\n\n"); 66 | 67 | struct_size(MP_INT); 68 | struct_field(MP_INT,_mp_alloc); 69 | struct_field(MP_INT,_mp_size); 70 | struct_field(MP_INT,_mp_d); 71 | 72 | return 0; 73 | } 74 | -------------------------------------------------------------------------------- /bitset.cabal: -------------------------------------------------------------------------------- 1 | Name: bitset 2 | Version: 1.4.8 3 | Synopsis: A space-efficient set data structure. 4 | Description: 5 | A /bit set/ is a compact data structure, which maintains a set of members 6 | from a type that can be enumerated (i. e. has an `Enum' instance). 7 | Category: Data Structures 8 | License: MIT 9 | License-file: LICENSE 10 | Data-files: CHANGES 11 | Author: Sergei Lebedev 12 | , Aleksey Kladov 13 | , Fedor Gogolev 14 | Maintainer: superbobry@gmail.com 15 | Bug-reports: http://github.com/lambda-llama/bitset/issues 16 | Stability: Experimental 17 | Cabal-Version: >= 1.12 18 | Build-type: Custom 19 | Tested-with: GHC == 7.4.1, GHC == 7.6.3, GHC == 7.8.4 20 | Extra-Source-Files: bin/mkDerivedGmpConstants.c, include/bitset.h 21 | 22 | Source-repository head 23 | Type: git 24 | Location: https://github.com/lambda-llama/bitset 25 | 26 | Library 27 | Hs-source-dirs: src 28 | Ghc-options: -Wall -fno-warn-orphans 29 | Default-language: Haskell2010 30 | Other-extensions: CPP, NamedFieldPuns, MagicHash, UnboxedTuples, 31 | BangPatterns, ForeignFunctionInterface, 32 | GHCForeignImportPrim, MagicHash, 33 | UnliftedFFITypes, UnboxedTuples, 34 | GeneralizedNewtypeDeriving, TypeFamilies, 35 | DeriveDataTypeable 36 | 37 | C-sources: cbits/gmp-extras.cmm 38 | Include-dirs: cbits, include 39 | 40 | if os(windows) 41 | Extra-libraries: gmp-10 42 | else 43 | Extra-libraries: gmp 44 | 45 | Build-depends: base >= 4.4.0 && < 4.8 46 | , deepseq 47 | , integer-gmp 48 | , ghc-prim 49 | 50 | Exposed-modules: Data.BitSet 51 | , Data.BitSet.Dynamic 52 | , Data.BitSet.Generic 53 | , Data.BitSet.Word 54 | Other-modules: GHC.Integer.GMP.PrimExt 55 | , GHC.Integer.GMP.TypeExt 56 | 57 | Test-suite bitset-tests 58 | Hs-source-dirs: tests 59 | Ghc-options: -Wall -O2 -fno-warn-orphans 60 | Default-language: Haskell2010 61 | Other-extensions: CPP 62 | 63 | Type: exitcode-stdio-1.0 64 | Main-is: Tests.hs 65 | 66 | Build-depends: base 67 | , QuickCheck 68 | , tasty 69 | , tasty-quickcheck 70 | , bitset 71 | 72 | Benchmark bitset-benchmarks 73 | Hs-source-dirs: src benchmarks 74 | Ghc-options: -Wall -fno-warn-orphans -O2 -optc-O3 -optc-msse4.1 75 | Default-language: Haskell2010 76 | Other-extensions: CPP, ExistentialQuantification 77 | 78 | C-sources: cbits/gmp-extras.cmm 79 | Include-dirs: cbits, include 80 | Extra-libraries: gmp 81 | 82 | Type: exitcode-stdio-1.0 83 | Main-is: Benchmarks.hs 84 | 85 | Build-depends: base 86 | , deepseq 87 | , integer-gmp 88 | , ghc-prim 89 | 90 | , criterion 91 | , containers 92 | , random 93 | , random-shuffle 94 | -------------------------------------------------------------------------------- /cbits/gmp-extras.cmm: -------------------------------------------------------------------------------- 1 | #include "Cmm.h" 2 | #include "GmpDerivedConstants.h" 3 | 4 | // TODO(superbobry): in the future release the syntax for calling 5 | // foreign funcations will CHANGE. 6 | 7 | import "integer-gmp" __gmpz_init_set; 8 | import "integer-gmp" __gmpz_popcount; 9 | import "integer-gmp" __gmpz_setbit; 10 | import "integer-gmp" __gmpz_clrbit; 11 | 12 | #if __GLASGOW_HASKELL__ >= 707 13 | 14 | #define GMP_TAKE1_UL1_RET1(name,mp_fun) \ 15 | name (W_ ws1, P_ d1, W_ wul) \ 16 | { \ 17 | CInt s1; \ 18 | CLong ul; \ 19 | W_ mp_tmp; \ 20 | W_ mp_result; \ 21 | \ 22 | /* call doYouWantToGC() */ \ 23 | again: \ 24 | STK_CHK_GEN_N (2 * SIZEOF_MP_INT); \ 25 | MAYBE_GC(again); \ 26 | \ 27 | s1 = W_TO_INT(ws1); \ 28 | ul = W_TO_LONG(wul); \ 29 | \ 30 | mp_tmp = Sp - 1 * SIZEOF_MP_INT; \ 31 | mp_result = Sp - 2 * SIZEOF_MP_INT; \ 32 | MP_INT__mp_alloc(mp_tmp) = W_TO_INT(BYTE_ARR_WDS(d1)); \ 33 | MP_INT__mp_size(mp_tmp) = (s1); \ 34 | MP_INT__mp_d(mp_tmp) = BYTE_ARR_CTS(d1); \ 35 | \ 36 | ccall __gmpz_init_set(mp_result "ptr", mp_tmp "ptr"); \ 37 | \ 38 | /* Perform the operation */ \ 39 | ccall mp_fun(mp_result "ptr", ul); \ 40 | \ 41 | return(TO_W_(MP_INT__mp_size(mp_result)), \ 42 | MP_INT__mp_d(mp_result) - SIZEOF_StgArrWords); \ 43 | } 44 | 45 | GMP_TAKE1_UL1_RET1(integer_cmm_setBitIntegerzh, __gmpz_setbit) 46 | GMP_TAKE1_UL1_RET1(integer_cmm_clearBitIntegerzh, __gmpz_clrbit) 47 | 48 | integer_cmm_popCountIntegerzh (W_ ws, W_ d) 49 | { 50 | CInt s, res; 51 | W_ mp_tmp; 52 | 53 | again: 54 | STK_CHK_P_LL(SIZEOF_MP_INT, integer_cmm_popCountIntegerzh, R2); 55 | MAYBE_GC(again); 56 | 57 | s = W_TO_INT(ws); 58 | 59 | mp_tmp = Sp - 1 * SIZEOF_MP_INT; 60 | MP_INT__mp_alloc(mp_tmp) = W_TO_INT(BYTE_ARR_WDS(d)); 61 | MP_INT__mp_size(mp_tmp) = (s); 62 | MP_INT__mp_d(mp_tmp) = BYTE_ARR_CTS(d); 63 | 64 | (res) = foreign "C" __gmpz_popcount(mp_tmp "ptr"); 65 | 66 | return (TO_W_(res)); 67 | } 68 | #else 69 | 70 | #define GMP_TAKE1_UL1_RET1(name,mp_fun) \ 71 | name \ 72 | { \ 73 | CInt s; \ 74 | W_ d; \ 75 | CLong ul; \ 76 | W_ mp_tmp; \ 77 | W_ mp_result; \ 78 | \ 79 | STK_CHK_GEN(2 * SIZEOF_MP_INT, R2, name); \ 80 | MAYBE_GC(R2_PTR, name); \ 81 | \ 82 | s = W_TO_INT(R1); \ 83 | d = R2; \ 84 | ul = R3; \ 85 | \ 86 | mp_tmp = Sp - 1 * SIZEOF_MP_INT; \ 87 | mp_result = Sp - 2 * SIZEOF_MP_INT; \ 88 | MP_INT__mp_alloc(mp_tmp) = W_TO_INT(BYTE_ARR_WDS(d)); \ 89 | MP_INT__mp_size(mp_tmp) = (s); \ 90 | MP_INT__mp_d(mp_tmp) = BYTE_ARR_CTS(d); \ 91 | \ 92 | foreign "C" __gmpz_init_set(mp_result "ptr", mp_tmp "ptr") [];\ 93 | \ 94 | /* Perform the operation */ \ 95 | foreign "C" mp_fun(mp_result "ptr", ul) []; \ 96 | \ 97 | RET_NP(TO_W_(MP_INT__mp_size(mp_result)), \ 98 | MP_INT__mp_d(mp_result) - SIZEOF_StgArrWords); \ 99 | } 100 | 101 | GMP_TAKE1_UL1_RET1(integer_cmm_setBitIntegerzh, __gmpz_setbit) 102 | GMP_TAKE1_UL1_RET1(integer_cmm_clearBitIntegerzh, __gmpz_clrbit) 103 | 104 | integer_cmm_testBitIntegerzh 105 | { 106 | CInt s, res; 107 | CLong ul; 108 | W_ d; 109 | W_ mp_tmp; 110 | 111 | STK_CHK_GEN(SIZEOF_MP_INT, R2_PTR, integer_cmm_testBitIntegerzh); 112 | MAYBE_GC(R2_PTR, integer_cmm_testBitIntegerzh); 113 | 114 | s = W_TO_INT(R1); 115 | d = R2; 116 | ul = R3; 117 | 118 | mp_tmp = Sp - 1 * SIZEOF_MP_INT; 119 | MP_INT__mp_alloc(mp_tmp) = W_TO_INT(BYTE_ARR_WDS(d)); 120 | MP_INT__mp_size(mp_tmp) = (s); 121 | MP_INT__mp_d(mp_tmp) = BYTE_ARR_CTS(d); 122 | 123 | (res) = foreign "C" __gmpz_tstbit(mp_tmp "ptr", ul) []; 124 | 125 | RET_N(TO_W_(res)); 126 | } 127 | 128 | integer_cmm_popCountIntegerzh 129 | { 130 | CInt s, res; 131 | W_ d; 132 | W_ mp_tmp; 133 | 134 | STK_CHK_GEN(SIZEOF_MP_INT, R2_PTR, integer_cmm_popCountIntegerzh); 135 | MAYBE_GC(R2_PTR, integer_cmm_popCountIntegerzh); 136 | 137 | s = W_TO_INT(R1); 138 | d = R2; 139 | 140 | mp_tmp = Sp - 1 * SIZEOF_MP_INT; 141 | MP_INT__mp_alloc(mp_tmp) = W_TO_INT(BYTE_ARR_WDS(d)); 142 | MP_INT__mp_size(mp_tmp) = (s); 143 | MP_INT__mp_d(mp_tmp) = BYTE_ARR_CTS(d); 144 | 145 | (res) = foreign "C" __gmpz_popcount(mp_tmp "ptr") []; 146 | 147 | RET_N(TO_W_(res)); 148 | } 149 | #endif -------------------------------------------------------------------------------- /include/bitset.h: -------------------------------------------------------------------------------- 1 | /* 2 | * Common macros for bitset 3 | */ 4 | 5 | #ifndef HASKELL_BITSET_H 6 | #define HASKELL_BITSET_H 7 | 8 | /* 9 | * We use cabal-generated MIN_VERSION_base to adapt to changes of base. 10 | * Nevertheless, as a convenience, we also allow compiling without cabal by 11 | * defining an approximate MIN_VERSION_base if needed. The alternative version 12 | * guesses the version of base using the version of GHC. This is usually 13 | * sufficiently accurate. However, it completely ignores minor version numbers, 14 | * and it makes the assumption that a pre-release version of GHC will ship with 15 | * base libraries with the same version numbers as the final release. This 16 | * assumption is violated in certain stages of GHC development, but in practice 17 | * this should very rarely matter, and will not affect any released version. 18 | */ 19 | #ifndef MIN_VERSION_base 20 | #if __GLASGOW_HASKELL__ >= 711 21 | #define MIN_VERSION_base(major1,major2,minor) (((major1)<4)||(((major2) == 4)&&((major2)<=9))) 22 | #elif __GLASGOW_HASKELL__ >= 709 23 | #define MIN_VERSION_base(major1,major2,minor) (((major1)<4)||(((major1) == 4)&&((major2)<=8))) 24 | #elif __GLASGOW_HASKELL__ >= 707 25 | #define MIN_VERSION_base(major1,major2,minor) (((major1)<4)||(((major1) == 4)&&((major2)<=7))) 26 | #elif __GLASGOW_HASKELL__ >= 705 27 | #define MIN_VERSION_base(major1,major2,minor) (((major1)<4)||(((major1) == 4)&&((major2)<=6))) 28 | #elif __GLASGOW_HASKELL__ >= 703 29 | #define MIN_VERSION_base(major1,major2,minor) (((major1)<4)||(((major1) == 4)&&((major2)<=5))) 30 | #elif __GLASGOW_HASKELL__ >= 701 31 | #define MIN_VERSION_base(major1,major2,minor) (((major1)<4)||(((major1) == 4)&&((major2)<=4))) 32 | #elif __GLASGOW_HASKELL__ >= 700 33 | #define MIN_VERSION_base(major1,major2,minor) (((major1)<4)||(((major1) == 4)&&((major2)<=3))) 34 | #else 35 | #define MIN_VERSION_base(major1,major2,minor) (0) 36 | #endif 37 | #endif 38 | 39 | #endif 40 | -------------------------------------------------------------------------------- /src/Data/BitSet.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Data.BitSet.Dynamic 4 | -- Copyright : (c) Sergei Lebedev, Aleksey Kladov, Fedor Gogolev 2013 5 | -- Based on Data.BitSet (c) Denis Bueno 2008-2009 6 | -- License : MIT 7 | -- Maintainer : superbobry@gmail.com 8 | -- Stability : experimental 9 | -- Portability : GHC 10 | -- 11 | -- A space-efficient implementation of set data structure for enumerated 12 | -- data types. 13 | 14 | module Data.BitSet ( module Data.BitSet.Dynamic ) where 15 | 16 | import Data.BitSet.Dynamic 17 | -------------------------------------------------------------------------------- /src/Data/BitSet/Dynamic.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE MagicHash #-} 3 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 4 | 5 | #include 6 | 7 | ----------------------------------------------------------------------------- 8 | -- | 9 | -- Module : Data.BitSet.Dynamic 10 | -- Copyright : (c) Sergei Lebedev, Aleksey Kladov, Fedor Gogolev 2013 11 | -- Based on Data.BitSet (c) Denis Bueno 2008-2009 12 | -- License : MIT 13 | -- Maintainer : superbobry@gmail.com 14 | -- Stability : experimental 15 | -- Portability : GHC 16 | -- 17 | -- A space-efficient implementation of set data structure for enumerated 18 | -- data types. 19 | -- 20 | -- /Note/: Read below the synopsis for important notes on the use of 21 | -- this module. 22 | -- 23 | -- This module is intended to be imported @qualified@, to avoid name 24 | -- clashes with "Prelude" functions, e.g. 25 | -- 26 | -- > import Data.BitSet.Dynamic (BitSet) 27 | -- > import qualified Data.BitSet.Dynamic as BS 28 | -- 29 | -- The implementation uses 'Integer' as underlying container, thus it 30 | -- grows automatically when more elements are inserted into the bit set. 31 | 32 | module Data.BitSet.Dynamic 33 | ( 34 | -- * Bit set type 35 | FasterInteger(FasterInteger) 36 | , BitSet 37 | 38 | -- * Operators 39 | , (\\) 40 | 41 | -- * Construction 42 | , empty 43 | , singleton 44 | , insert 45 | , delete 46 | 47 | -- * Query 48 | , null 49 | , size 50 | , member 51 | , notMember 52 | , isSubsetOf 53 | , isProperSubsetOf 54 | 55 | -- * Combine 56 | , union 57 | , difference 58 | , intersection 59 | 60 | -- * Transformations 61 | , map 62 | 63 | -- * Folds 64 | , foldl' 65 | , foldr 66 | 67 | -- * Filter 68 | , filter 69 | 70 | -- * Lists 71 | , toList 72 | , fromList 73 | ) where 74 | 75 | import Prelude hiding (null, map, filter, foldr) 76 | 77 | import Data.Bits (Bits(..)) 78 | import GHC.Base (Int(..)) 79 | 80 | import Control.DeepSeq (NFData(..)) 81 | 82 | import GHC.Integer.GMP.TypeExt (popCountInteger, testBitInteger, 83 | setBitInteger, clearBitInteger) 84 | import qualified Data.BitSet.Generic as GS 85 | 86 | -- | A wrapper around 'Integer' which provides faster bit-level operations. 87 | newtype FasterInteger = FasterInteger { unFI :: Integer } 88 | deriving (Read, Show, Eq, Ord, Enum, Integral, Num, Real, NFData) 89 | 90 | instance Bits FasterInteger where 91 | FasterInteger x .&. FasterInteger y = FasterInteger $ x .&. y 92 | {-# INLINE (.&.) #-} 93 | 94 | FasterInteger x .|. FasterInteger y = FasterInteger $ x .|. y 95 | {-# INLINE (.|.) #-} 96 | 97 | FasterInteger x `xor` FasterInteger y = FasterInteger $ x `xor` y 98 | {-# INLINE xor #-} 99 | 100 | complement = FasterInteger . complement . unFI 101 | {-# INLINE complement #-} 102 | 103 | shift (FasterInteger x) = FasterInteger . shift x 104 | {-# INLINE shift #-} 105 | 106 | rotate (FasterInteger x) = FasterInteger . rotate x 107 | {-# INLINE rotate #-} 108 | 109 | bit = FasterInteger . bit 110 | {-# INLINE bit #-} 111 | 112 | testBit (FasterInteger x) (I# i) = testBitInteger x i 113 | {-# SPECIALIZE INLINE testBit :: FasterInteger -> Int -> Bool #-} 114 | 115 | setBit (FasterInteger x) (I# i) = FasterInteger $ setBitInteger x i 116 | {-# SPECIALIZE INLINE setBit :: FasterInteger -> Int -> FasterInteger #-} 117 | 118 | clearBit (FasterInteger x) (I# i) = FasterInteger $ clearBitInteger x i 119 | {-# SPECIALIZE INLINE clearBit :: FasterInteger -> Int -> FasterInteger #-} 120 | 121 | popCount (FasterInteger x) = I# (popCountInteger x) 122 | {-# SPECIALIZE INLINE popCount :: FasterInteger -> Int #-} 123 | 124 | isSigned = isSigned . unFI 125 | {-# INLINE isSigned #-} 126 | 127 | bitSize _ = error "bitSize: FasterInteger does not support bitSize." 128 | 129 | #if MIN_VERSION_base(4,7,0) 130 | bitSizeMaybe _ = Nothing 131 | {-# INLINE bitSizeMaybe #-} 132 | #endif 133 | 134 | type BitSet = GS.BitSet FasterInteger 135 | 136 | -- | /O(1)/. Is the bit set empty? 137 | null :: BitSet a -> Bool 138 | null = GS.null 139 | {-# INLINE null #-} 140 | 141 | -- | /O(1)/. The number of elements in the bit set. 142 | size :: BitSet a -> Int 143 | size = GS.size 144 | {-# INLINE size #-} 145 | 146 | -- | /O(1)/. Ask whether the item is in the bit set. 147 | member :: Enum a => a -> BitSet a -> Bool 148 | member = GS.member 149 | {-# INLINE member #-} 150 | 151 | -- | /O(1)/. Ask whether the item is in the bit set. 152 | notMember :: Enum a => a -> BitSet a -> Bool 153 | notMember = GS.notMember 154 | {-# INLINE notMember #-} 155 | 156 | -- | /O(max(n, m))/. Is this a subset? (@s1 isSubsetOf s2@) tells whether 157 | -- @s1@ is a subset of @s2@. 158 | isSubsetOf :: BitSet a -> BitSet a -> Bool 159 | isSubsetOf = GS.isSubsetOf 160 | {-# INLINE isSubsetOf #-} 161 | 162 | -- | /O(max(n, m)/. Is this a proper subset? (ie. a subset but not equal). 163 | isProperSubsetOf :: BitSet a -> BitSet a -> Bool 164 | isProperSubsetOf = GS.isProperSubsetOf 165 | {-# INLINE isProperSubsetOf #-} 166 | 167 | -- | The empty bit set. 168 | empty :: Enum a => BitSet a 169 | empty = GS.empty 170 | {-# INLINE empty #-} 171 | 172 | -- | O(1). Create a singleton set. 173 | singleton :: Enum a => a -> BitSet a 174 | singleton = GS.singleton 175 | {-# INLINE singleton #-} 176 | 177 | -- | /O(1)/. Insert an item into the bit set. 178 | insert :: Enum a => a -> BitSet a -> BitSet a 179 | insert = GS.insert 180 | {-# INLINE insert #-} 181 | 182 | -- | /O(1)/. Delete an item from the bit set. 183 | delete :: Enum a => a -> BitSet a -> BitSet a 184 | delete = GS.delete 185 | {-# INLINE delete #-} 186 | 187 | -- | /O(max(m, n))/. The union of two bit sets. 188 | union :: BitSet a -> BitSet a -> BitSet a 189 | union = GS.union 190 | {-# INLINE union #-} 191 | 192 | -- | /O(1)/. Difference of two bit sets. 193 | difference :: BitSet a -> BitSet a -> BitSet a 194 | difference = GS.difference 195 | {-# INLINE difference #-} 196 | 197 | -- | /O(1)/. See `difference'. 198 | (\\) :: BitSet a -> BitSet a -> BitSet a 199 | (\\) = difference 200 | 201 | -- | /O(1)/. The intersection of two bit sets. 202 | intersection :: BitSet a -> BitSet a -> BitSet a 203 | intersection = GS.intersection 204 | {-# INLINE intersection #-} 205 | 206 | -- | /O(n)/ Transform this bit set by applying a function to every value. 207 | -- Resulting bit set may be smaller then the original. 208 | map :: (Enum a, Enum b) => (a -> b) -> BitSet a -> BitSet b 209 | map = GS.map 210 | {-# INLINE map #-} 211 | 212 | -- | /O(n)/ Reduce this bit set by applying a binary function to all 213 | -- elements, using the given starting value. Each application of the 214 | -- operator is evaluated before before using the result in the next 215 | -- application. This function is strict in the starting value. 216 | foldl' :: Enum a => (b -> a -> b) -> b -> BitSet a -> b 217 | foldl' = GS.foldl' 218 | {-# INLINE foldl' #-} 219 | 220 | -- | /O(n)/ Reduce this bit set by applying a binary function to all 221 | -- elements, using the given starting value. 222 | foldr :: Enum a => (a -> b -> b) -> b -> BitSet a -> b 223 | foldr = GS.foldr 224 | {-# INLINE foldr #-} 225 | 226 | -- | /O(n)/ Filter this bit set by retaining only elements satisfying a 227 | -- predicate. 228 | filter :: Enum a => (a -> Bool) -> BitSet a -> BitSet a 229 | filter = GS.filter 230 | {-# INLINE filter #-} 231 | 232 | -- | /O(n)/. Convert the bit set set to a list of elements. 233 | toList :: Enum a => BitSet a -> [a] 234 | toList = GS.toList 235 | {-# INLINE toList #-} 236 | 237 | -- | /O(n)/. Make a bit set from a list of elements. 238 | fromList :: Enum a => [a] -> BitSet a 239 | fromList = GS.fromList 240 | {-# INLINE fromList #-} 241 | -------------------------------------------------------------------------------- /src/Data/BitSet/Generic.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Data.BitSet.Generic 4 | -- Copyright : (c) Sergei Lebedev, Aleksey Kladov, Fedor Gogolev 2013 5 | -- Based on Data.BitSet (c) Denis Bueno 2008-2009 6 | -- License : MIT 7 | -- Maintainer : superbobry@gmail.com 8 | -- Stability : experimental 9 | -- Portability : GHC 10 | -- 11 | -- A space-efficient implementation of set data structure for enumerated 12 | -- data types. 13 | -- 14 | -- /Note/: Read below the synopsis for important notes on the use of 15 | -- this module. 16 | -- 17 | -- This module is intended to be imported @qualified@, to avoid name 18 | -- clashes with "Prelude" functions, e.g. 19 | -- 20 | -- > import Data.BitSet.Generic (BitSet) 21 | -- > import qualified Data.BitSet.Generic as BS 22 | -- 23 | -- The implementation is abstract with respect to container type, so any 24 | -- numeric type with 'Bits' instance can be used as a container. However, 25 | -- independent of container choice, the maximum number of elements in a 26 | -- bit set is bounded by @maxBound :: Int@. 27 | 28 | {-# LANGUAGE CPP #-} 29 | {-# LANGUAGE TypeFamilies #-} 30 | {-# LANGUAGE BangPatterns #-} 31 | {-# LANGUAGE DeriveDataTypeable #-} 32 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 33 | 34 | #include 35 | 36 | module Data.BitSet.Generic 37 | ( 38 | -- * Bit set type 39 | BitSet(..) 40 | 41 | -- * Operators 42 | , (\\) 43 | 44 | -- * Construction 45 | , empty 46 | , singleton 47 | , insert 48 | , delete 49 | 50 | -- * Query 51 | , null 52 | , size 53 | , member 54 | , notMember 55 | , isSubsetOf 56 | , isProperSubsetOf 57 | 58 | -- * Combine 59 | , union 60 | , difference 61 | , intersection 62 | 63 | -- * Transformations 64 | , map 65 | 66 | -- * Folds 67 | , foldl' 68 | , foldr 69 | 70 | -- * Filter 71 | , filter 72 | 73 | -- * Lists 74 | , toList 75 | , fromList 76 | ) where 77 | 78 | import Prelude hiding (null, map, filter, foldr) 79 | 80 | import Control.Applicative ((<$>)) 81 | import Control.DeepSeq (NFData(..)) 82 | import Data.Bits (Bits, (.|.), (.&.), complement, bit, 83 | testBit, setBit, clearBit, popCount) 84 | #if MIN_VERSION_base(4,7,0) 85 | import Data.Bits (bitSizeMaybe, isSigned, unsafeShiftR, zeroBits) 86 | #endif 87 | import Data.Data (Typeable) 88 | import Data.Monoid (Monoid(..)) 89 | import Foreign (Storable) 90 | import GHC.Exts (build) 91 | #if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 707) 92 | import GHC.Exts (IsList) 93 | import qualified GHC.Exts as Exts 94 | #endif 95 | import Text.Read (Read(..), Lexeme(..), lexP, prec, parens) 96 | import qualified Data.List as List 97 | 98 | -- | A bit set with unspecified container type. 99 | newtype BitSet c a = BitSet { getBits :: c } 100 | deriving (Eq, NFData, Storable, Ord, Typeable) 101 | 102 | instance (Enum a, Read a, Bits c) => Read (BitSet c a) where 103 | readPrec = parens . prec 10 $ do 104 | Ident "fromList" <- lexP 105 | fromList <$> readPrec 106 | 107 | instance (Enum a, Show a, Bits c) => Show (BitSet c a) where 108 | showsPrec p bs = showParen (p > 10) $ 109 | showString "fromList " . shows (toList bs) 110 | 111 | instance Bits c => Monoid (BitSet c a) where 112 | mempty = empty 113 | mappend = union 114 | 115 | #if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 707) 116 | instance (Enum a, Bits c) => IsList (BitSet c a) where 117 | type Item (BitSet c a) = a 118 | fromList = fromList 119 | toList = toList 120 | #endif 121 | 122 | #if !MIN_VERSION_base(4,7,0) 123 | zeroBits :: Bits c => c 124 | zeroBits = bit 0 `clearBit` 0 125 | {-# INLINE zeroBits #-} 126 | #endif 127 | 128 | -- | /O(1)/. Is the bit set empty? 129 | null :: Bits c => BitSet c a -> Bool 130 | null = (== zeroBits) . getBits 131 | {-# INLINE null #-} 132 | 133 | -- | /O(1)/. The number of elements in the bit set. 134 | size :: Bits c => BitSet c a -> Int 135 | size = popCount . getBits 136 | {-# INLINE size #-} 137 | 138 | -- | /O(d)/. Ask whether the item is in the bit set. 139 | member :: (Enum a , Bits c) => a -> BitSet c a -> Bool 140 | member x = (`testBit` fromEnum x) . getBits 141 | {-# INLINE member #-} 142 | 143 | -- | /O(d)/. Ask whether the item is not in the bit set. 144 | notMember :: (Enum a, Bits c) => a -> BitSet c a -> Bool 145 | notMember x = not . member x 146 | {-# INLINE notMember #-} 147 | 148 | -- | /O(max(n, m))/. Is this a subset? (@s1 `isSubsetOf` s2@) tells whether 149 | -- @s1@ is a subset of @s2@. 150 | isSubsetOf :: Bits c => BitSet c a -> BitSet c a -> Bool 151 | isSubsetOf (BitSet bits1) (BitSet bits2) = bits2 .|. bits1 == bits2 152 | {-# INLINE isSubsetOf #-} 153 | 154 | -- | /O(max(n, m)/. Is this a proper subset? (ie. a subset but not equal). 155 | isProperSubsetOf :: Bits c => BitSet c a -> BitSet c a -> Bool 156 | isProperSubsetOf bs1 bs2 = bs1 `isSubsetOf` bs2 && bs1 /= bs2 157 | {-# INLINE isProperSubsetOf #-} 158 | 159 | -- | The empty bit set. 160 | empty :: Bits c => BitSet c a 161 | empty = BitSet zeroBits 162 | {-# INLINE empty #-} 163 | 164 | -- | O(1). Create a singleton set. 165 | singleton :: (Enum a, Bits c) => a -> BitSet c a 166 | singleton = BitSet . bit . fromEnum 167 | {-# INLINE singleton #-} 168 | 169 | -- | /O(d)/. Insert an item into the bit set. 170 | insert :: (Enum a, Bits c) => a -> BitSet c a -> BitSet c a 171 | insert x (BitSet bits) = BitSet $ bits `setBit` fromEnum x 172 | {-# INLINE insert #-} 173 | 174 | -- | /O(d)/. Delete an item from the bit set. 175 | delete :: (Enum a, Bits c) => a -> BitSet c a -> BitSet c a 176 | delete x (BitSet bits ) = BitSet $ bits `clearBit` fromEnum x 177 | {-# INLINE delete #-} 178 | 179 | -- | /O(max(m, n))/. The union of two bit sets. 180 | union :: Bits c => BitSet c a -> BitSet c a -> BitSet c a 181 | union (BitSet bits1) (BitSet bits2) = BitSet $ bits1 .|. bits2 182 | {-# INLINE union #-} 183 | 184 | -- | /O(max(m, n))/. Difference of two bit sets. 185 | difference :: Bits c => BitSet c a -> BitSet c a -> BitSet c a 186 | difference (BitSet bits1) (BitSet bits2) = BitSet $ bits1 .&. complement bits2 187 | {-# INLINE difference #-} 188 | 189 | -- | /O(max(m, n))/. See 'difference'. 190 | (\\) :: Bits c => BitSet c a -> BitSet c a -> BitSet c a 191 | (\\) = difference 192 | 193 | -- | /O(max(m, n))/. The intersection of two bit sets. 194 | intersection :: Bits c => BitSet c a -> BitSet c a -> BitSet c a 195 | intersection (BitSet bits1) (BitSet bits2) = BitSet $ bits1 .&. bits2 196 | {-# INLINE intersection #-} 197 | 198 | -- | /O(d * n)/ Transform this bit set by applying a function to every 199 | -- value. Resulting bit set may be smaller then the original. 200 | map :: (Enum a, Enum b, Bits c) => (a -> b) -> BitSet c a -> BitSet c b 201 | map f = foldl' (\bs -> (`insert` bs) . f) empty 202 | {-# INLINE map #-} 203 | 204 | -- | /O(d * n)/ Reduce this bit set by applying a binary function to all 205 | -- elements, using the given starting value. Each application of the 206 | -- operator is evaluated before before using the result in the next 207 | -- application. This function is strict in the starting value. 208 | foldl' :: (Enum a, Bits c) => (b -> a -> b) -> b -> BitSet c a -> b 209 | #if MIN_VERSION_base(4,7,0) 210 | -- If the bit set is represented by an unsigned type 211 | -- then we can shift the bits off one by one until we're 212 | -- left with all zeros. If the type is fairly narrow, then 213 | -- this is likely to be cheap. In particular, in this case 214 | -- we don't need to calculate the `popCount` and all shifts 215 | -- are by fixed amounts. 216 | foldl' f acc0 (BitSet bits0) 217 | | not (isSigned bits0) && maybe False (<= 128) (bitSizeMaybe bits0) = 218 | go acc0 bits0 0 219 | where 220 | go !acc !bits !b 221 | | bits == zeroBits = acc 222 | | bits `testBit` 0 = go (f acc $ toEnum b) (bits `unsafeShiftR` 1) (b + 1) 223 | | otherwise = go acc (bits `unsafeShiftR` 1) (b + 1) 224 | #endif 225 | foldl' f acc0 (BitSet bits) = go acc0 (popCount bits) 0 226 | where 227 | go !acc 0 !_b = acc 228 | go !acc n !b = if bits `testBit` b 229 | then go (f acc $ toEnum b) (n - 1) (b + 1) 230 | else go acc n (b + 1) 231 | {-# INLINE foldl' #-} 232 | 233 | -- | /O(d * n)/ Reduce this bit set by applying a binary function to 234 | -- all elements, using the given starting value. 235 | foldr :: (Enum a, Bits c) => (a -> b -> b) -> b -> BitSet c a -> b 236 | #if MIN_VERSION_base(4,7,0) 237 | foldr f acc0 (BitSet bits0) 238 | | not (isSigned bits0) && maybe False (<= 128) (bitSizeMaybe bits0) = go bits0 0 239 | where 240 | go !bits !b 241 | | bits == zeroBits = acc0 242 | | bits `testBit` 0 = toEnum b `f` go (bits `unsafeShiftR` 1) (b + 1) 243 | | otherwise = go (bits `unsafeShiftR` 1) (b + 1) 244 | #endif 245 | foldr f acc0 (BitSet bits) = go (popCount bits) 0 where 246 | go 0 _b = acc0 247 | go !n b = if bits `testBit` b 248 | then toEnum b `f` go (n - 1) (b + 1) 249 | else go n (b + 1) 250 | {-# INLINE foldr #-} 251 | 252 | -- | /O(d * n)/ Filter this bit set by retaining only elements satisfying 253 | -- predicate. 254 | filter :: (Enum a, Bits c) => (a -> Bool) -> BitSet c a -> BitSet c a 255 | filter f = foldl' (\bs x -> if f x then x `insert` bs else bs) empty 256 | {-# INLINE filter #-} 257 | 258 | -- | /O(d * n)/. Convert this bit set set to a list of elements. 259 | toList :: (Enum a, Bits c) => BitSet c a -> [a] 260 | toList bs = build (\k z -> foldr k z bs) 261 | {-# INLINE [0] toList #-} 262 | 263 | -- | /O(d * n)/. Make a bit set from a list of elements. 264 | fromList :: (Enum a, Bits c) => [a] -> BitSet c a 265 | fromList = List.foldl' (\i x -> insert x i) empty 266 | {-# INLINE [0] fromList #-} 267 | {-# RULES 268 | "fromList/toList" forall bs. fromList (toList bs) = bs 269 | #-} 270 | -------------------------------------------------------------------------------- /src/Data/BitSet/Word.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Data.BitSet.Word 4 | -- Copyright : (c) Sergei Lebedev, Aleksey Kladov, Fedor Gogolev 2013 5 | -- Based on Data.BitSet (c) Denis Bueno 2008-2009 6 | -- License : MIT 7 | -- Maintainer : superbobry@gmail.com 8 | -- Stability : experimental 9 | -- Portability : GHC 10 | -- 11 | -- A space-efficient implementation of set data structure for enumerated 12 | -- data types. 13 | -- 14 | -- /Note/: Read below the synopsis for important notes on the use of 15 | -- this module. 16 | -- 17 | -- This module is intended to be imported @qualified@, to avoid name 18 | -- clashes with "Prelude" functions, e.g. 19 | -- 20 | -- > import Data.BitSet.Word (BitSet) 21 | -- > import qualified Data.BitSet.Word as BS 22 | -- 23 | -- The implementation uses 'Word' as underlying container, thus the 24 | -- maximum number of elements you can store in this bit set is bounded 25 | -- by the number of bits in 'Word' data type. However, due to native bitwise 26 | -- operations "Data.BitSet.Word" is significantly faster then "Data.Set" 27 | -- on all operations. 28 | 29 | module Data.BitSet.Word 30 | ( 31 | -- * Bit set type 32 | BitSet 33 | 34 | -- * Operators 35 | , (\\) 36 | 37 | -- * Construction 38 | , empty 39 | , singleton 40 | , insert 41 | , delete 42 | 43 | -- * Query 44 | , null 45 | , size 46 | , member 47 | , notMember 48 | , isSubsetOf 49 | , isProperSubsetOf 50 | 51 | -- * Combine 52 | , union 53 | , difference 54 | , intersection 55 | 56 | -- * Transformations 57 | , map 58 | 59 | -- * Folds 60 | , foldl' 61 | , foldr 62 | 63 | -- * Filter 64 | , filter 65 | 66 | -- * Lists 67 | , toList 68 | , fromList 69 | ) where 70 | 71 | import Prelude hiding (null, map, filter, foldr) 72 | 73 | import Data.Word (Word) 74 | 75 | import qualified Data.BitSet.Generic as GS 76 | 77 | type BitSet = GS.BitSet Word 78 | 79 | -- | /O(1)/. Is the bit set empty? 80 | null :: BitSet a -> Bool 81 | null = GS.null 82 | {-# INLINE null #-} 83 | 84 | -- | /O(1)/. The number of elements in the bit set. 85 | size :: BitSet a -> Int 86 | size = GS.size 87 | {-# INLINE size #-} 88 | 89 | -- | /O(1)/. Ask whether the item is in the bit set. 90 | member :: Enum a => a -> BitSet a -> Bool 91 | member = GS.member 92 | {-# INLINE member #-} 93 | 94 | -- | /O(1)/. Ask whether the item is in the bit set. 95 | notMember :: Enum a => a -> BitSet a -> Bool 96 | notMember = GS.notMember 97 | {-# INLINE notMember #-} 98 | 99 | -- | /O(1)/. Is this a subset? (@s1 isSubsetOf s2@) tells whether 100 | -- @s1@ is a subset of @s2@. 101 | isSubsetOf :: BitSet a -> BitSet a -> Bool 102 | isSubsetOf = GS.isSubsetOf 103 | {-# INLINE isSubsetOf #-} 104 | 105 | -- | /O(1)/. Is this a proper subset? (ie. a subset but not equal). 106 | isProperSubsetOf :: BitSet a -> BitSet a -> Bool 107 | isProperSubsetOf = GS.isProperSubsetOf 108 | {-# INLINE isProperSubsetOf #-} 109 | 110 | -- | The empty bit set. 111 | empty :: Enum a => BitSet a 112 | empty = GS.empty 113 | {-# INLINE empty #-} 114 | 115 | -- | O(1). Create a singleton set. 116 | singleton :: Enum a => a -> BitSet a 117 | singleton = GS.singleton 118 | {-# INLINE singleton #-} 119 | 120 | -- | /O(1)/. Insert an item into the bit set. 121 | insert :: Enum a => a -> BitSet a -> BitSet a 122 | insert = GS.insert 123 | {-# INLINE insert #-} 124 | 125 | -- | /O(1)/. Delete an item from the bit set. 126 | delete :: Enum a => a -> BitSet a -> BitSet a 127 | delete = GS.delete 128 | {-# INLINE delete #-} 129 | 130 | -- | /O(1)/. The union of two bit sets. 131 | union :: BitSet a -> BitSet a -> BitSet a 132 | union = GS.union 133 | {-# INLINE union #-} 134 | 135 | -- | /O(1)/. Difference of two bit sets. 136 | difference :: BitSet a -> BitSet a -> BitSet a 137 | difference = GS.difference 138 | {-# INLINE difference #-} 139 | 140 | -- | /O(1)/. See `difference'. 141 | (\\) :: BitSet a -> BitSet a -> BitSet a 142 | (\\) = difference 143 | 144 | -- | /O(1)/. The intersection of two bit sets. 145 | intersection :: BitSet a -> BitSet a -> BitSet a 146 | intersection = GS.intersection 147 | {-# INLINE intersection #-} 148 | 149 | -- | /O(n)/ Transform this bit set by applying a function to every value. 150 | -- Resulting bit set may be smaller then the original. 151 | map :: (Enum a, Enum b) => (a -> b) -> BitSet a -> BitSet b 152 | map = GS.map 153 | {-# INLINE map #-} 154 | 155 | -- | /O(n)/ Reduce this bit set by applying a binary function to all 156 | -- elements, using the given starting value. Each application of the 157 | -- operator is evaluated before before using the result in the next 158 | -- application. This function is strict in the starting value. 159 | foldl' :: Enum a => (b -> a -> b) -> b -> BitSet a -> b 160 | foldl' = GS.foldl' 161 | {-# INLINE foldl' #-} 162 | 163 | -- | /O(n)/ Reduce this bit set by applying a binary function to all 164 | -- elements, using the given starting value. 165 | foldr :: Enum a => (a -> b -> b) -> b -> BitSet a -> b 166 | foldr = GS.foldr 167 | {-# INLINE foldr #-} 168 | 169 | -- | /O(n)/ Filter this bit set by retaining only elements satisfying a 170 | -- predicate. 171 | filter :: Enum a => (a -> Bool) -> BitSet a -> BitSet a 172 | filter = GS.filter 173 | {-# INLINE filter #-} 174 | 175 | -- | /O(n)/. Convert the bit set set to a list of elements. 176 | toList :: Enum a => BitSet a -> [a] 177 | toList = GS.toList 178 | {-# INLINE toList #-} 179 | 180 | -- | /O(n)/. Make a bit set from a list of elements. 181 | fromList :: Enum a => [a] -> BitSet a 182 | fromList = GS.fromList 183 | {-# INLINE fromList #-} 184 | -------------------------------------------------------------------------------- /src/GHC/Integer/GMP/PrimExt.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ForeignFunctionInterface #-} 2 | {-# LANGUAGE GHCForeignImportPrim #-} 3 | {-# LANGUAGE MagicHash #-} 4 | {-# LANGUAGE UnliftedFFITypes #-} 5 | {-# LANGUAGE UnboxedTuples #-} 6 | 7 | module GHC.Integer.GMP.PrimExt 8 | ( popCountInteger# 9 | , testBitInteger# 10 | , setBitInteger# 11 | , clearBitInteger# 12 | ) where 13 | 14 | import GHC.Prim (Int#, ByteArray#) 15 | 16 | foreign import prim "integer_cmm_popCountIntegerzh" popCountInteger# 17 | :: Int# -> ByteArray# -> Int# 18 | 19 | foreign import prim "integer_cmm_testBitIntegerzh" testBitInteger# 20 | :: Int# -> ByteArray# -> Int# -> Int# 21 | 22 | foreign import prim "integer_cmm_setBitIntegerzh" setBitInteger# 23 | :: Int# -> ByteArray# -> Int# -> (# Int#, ByteArray# #) 24 | 25 | foreign import prim "integer_cmm_clearBitIntegerzh" clearBitInteger# 26 | :: Int# -> ByteArray# -> Int# -> (# Int#, ByteArray# #) 27 | -------------------------------------------------------------------------------- /src/GHC/Integer/GMP/TypeExt.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE MagicHash #-} 3 | {-# LANGUAGE UnboxedTuples #-} 4 | {-# LANGUAGE BangPatterns #-} 5 | 6 | module GHC.Integer.GMP.TypeExt 7 | ( popCountInteger 8 | , testBitInteger 9 | , setBitInteger 10 | , clearBitInteger 11 | ) where 12 | 13 | #include "MachDeps.h" 14 | 15 | import GHC.Integer.GMP.Internals (Integer(..)) 16 | import GHC.Integer.GMP.Prim (int2Integer#) 17 | import GHC.Prim (Int#, (/=#), (>=#), (<#), (-#), 18 | int2Word#, word2Int#, popCnt#, 19 | negateInt#, and#, or#, xor#, uncheckedIShiftL#) 20 | 21 | import GHC.Integer.GMP.PrimExt (popCountInteger#, testBitInteger#, 22 | setBitInteger#, clearBitInteger#) 23 | 24 | #if __GLASGOW_HASKELL__ >= 707 25 | import GHC.Exts (isTrue#) 26 | #else 27 | isTrue# = id 28 | #endif 29 | 30 | popCountInteger :: Integer -> Int# 31 | popCountInteger (S# i) = word2Int# (popCnt# (int2Word# i)) 32 | popCountInteger (J# s d) = popCountInteger# s d 33 | {-# NOINLINE popCountInteger #-} 34 | 35 | testBitInteger :: Integer -> Int# -> Bool 36 | testBitInteger (S# j) i 37 | | isTrue# (i <# 0#) = False 38 | | isTrue# (i <# (WORD_SIZE_IN_BITS# -# 1#)) = 39 | let !mask = 1# `uncheckedIShiftL#` i in 40 | isTrue# (word2Int# (int2Word# j `and#` int2Word# mask) /=# 0#) 41 | | otherwise = 42 | let !(# s, d #) = int2Integer# j in testBitInteger (J# s d) i 43 | testBitInteger (J# s d) i = isTrue# (testBitInteger# s d i /=# 0#) 44 | {-# NOINLINE testBitInteger #-} 45 | 46 | setBitInteger :: Integer -> Int# -> Integer 47 | setBitInteger (S# j) i 48 | | isTrue# (i <# 0#) = S# j 49 | | isTrue# (i <# (WORD_SIZE_IN_BITS# -# 1#)) = 50 | let !mask = 1# `uncheckedIShiftL#` i in 51 | S# (word2Int# (int2Word# j `or#` int2Word# mask)) 52 | | otherwise = 53 | let !(# s, d #) = int2Integer# j in setBitInteger (J# s d) i 54 | setBitInteger (J# s d) i = 55 | let !(# s', d' #) = setBitInteger# s d i in J# s' d' 56 | {-# NOINLINE setBitInteger #-} 57 | 58 | clearBitInteger :: Integer -> Int# -> Integer 59 | clearBitInteger (S# j) i 60 | | isTrue# (i <# 0#) || isTrue# (i >=# (WORD_SIZE_IN_BITS# -# 1#)) = S# j 61 | | otherwise = 62 | let !mask = 63 | int2Word# (1# `uncheckedIShiftL#` i) `xor#` 64 | int2Word# (negateInt# 1#) 65 | in S# (word2Int# (int2Word# j `and#` mask)) 66 | clearBitInteger (J# s d) i = 67 | let !(# s', d' #) = clearBitInteger# s d i in J# s' d' 68 | {-# NOINLINE clearBitInteger #-} -------------------------------------------------------------------------------- /tests/Tests.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | 3 | module Main (main) where 4 | 5 | import Control.Applicative ((<$>)) 6 | import Data.Bits (Bits, popCount, testBit, setBit, clearBit) 7 | import Data.Int (Int16) 8 | import Data.List ((\\), intersect, union, nub, sort) 9 | import Data.Monoid ((<>), mempty) 10 | import Data.Word (Word, Word16) 11 | import Foreign (Storable(..), allocaBytes) 12 | 13 | import Test.Tasty (TestTree, testGroup, defaultMain) 14 | import Test.Tasty.QuickCheck (testProperty) 15 | import Test.QuickCheck (Property, Arbitrary(..), CoArbitrary (..), (==>), classify, (===), choose) 16 | import Test.QuickCheck.Function (Fun, Function (..), apply, functionMap) 17 | import Test.QuickCheck.Monadic (monadicIO, assert, run) 18 | 19 | import Data.BitSet (BitSet) 20 | import Data.BitSet.Dynamic (FasterInteger(..)) 21 | import qualified Data.BitSet as BS 22 | import qualified Data.BitSet.Generic as GS 23 | 24 | instance (Arbitrary a, Enum a, Bits b) => Arbitrary (GS.BitSet b a) where 25 | arbitrary = GS.fromList <$> arbitrary 26 | 27 | instance Arbitrary FasterInteger where 28 | arbitrary = FasterInteger <$> arbitrary 29 | 30 | -- QuickCheck 2.8 does not offer a Function instance 31 | -- for Word16 ( https://github.com/nick8325/quickcheck/issues/97 ). 32 | -- We use a wrapper to work around that. 33 | newtype Word16' = Word16' { getWord16 :: Word16 } deriving (Eq, Show) 34 | 35 | instance CoArbitrary Word16' where 36 | coarbitrary = coarbitrary . getWord16 37 | 38 | instance Function Word16' where 39 | function = functionMap (fromIntegral . getWord16) (Word16' . fromInteger) 40 | 41 | propSize :: [Word16] -> Bool 42 | propSize = go . nub where 43 | go xs = length xs == BS.size (BS.fromList xs) 44 | 45 | propSizeAfterInsert :: Word16 -> BitSet Word16 -> Bool 46 | propSizeAfterInsert x bs = 47 | BS.size (BS.insert x bs) == BS.size bs + diff 48 | where 49 | diff :: Int 50 | diff = if x `BS.member` bs then 0 else 1 51 | 52 | propSizeAfterDelete :: Word16 -> BitSet Word16 -> Bool 53 | propSizeAfterDelete x bs = 54 | BS.size (BS.delete x bs) == BS.size bs - diff 55 | where 56 | diff :: Int 57 | diff = if x `BS.member` bs then 1 else 0 58 | 59 | propInsertMember :: Word16 -> BitSet Word16 -> Bool 60 | propInsertMember x bs = x `BS.member` BS.insert x bs 61 | 62 | propDeleteMember :: Word16 -> BitSet Word16 -> Bool 63 | propDeleteMember x bs = x `BS.notMember` BS.delete x bs 64 | 65 | propInsertDeleteIdempotent :: Word16 -> BitSet Word16 -> Property 66 | propInsertDeleteIdempotent x bs = 67 | x `BS.notMember` bs ==> 68 | bs == BS.delete x (BS.insert x bs) 69 | 70 | propDeleteIdempotent :: Word16 -> BitSet Word16 -> Property 71 | propDeleteIdempotent x bs = 72 | classify (x `BS.member` bs) "x in bs" $ 73 | classify (x `BS.notMember` bs) "x not in bs" $ 74 | BS.delete x bs == BS.delete x (BS.delete x bs) 75 | 76 | propInsertIdempotent :: Word16 -> BitSet Word16 -> Bool 77 | propInsertIdempotent x bs = 78 | BS.insert x bs == BS.insert x (BS.insert x bs) 79 | 80 | propToList :: [Word16] -> Bool 81 | propToList xs = nub (sort xs) == BS.toList bs where 82 | bs :: BitSet Word16 83 | bs = BS.fromList xs 84 | 85 | propFromList :: [Word16] -> Bool 86 | propFromList xs = all (`BS.member` bs) xs where 87 | bs :: BitSet Word16 88 | bs = BS.fromList xs 89 | 90 | propEmpty :: Word16 -> Bool 91 | propEmpty x = x `BS.notMember` BS.empty 92 | 93 | propNullEmpty :: Bool 94 | propNullEmpty = BS.null bs where 95 | bs :: BitSet Word16 96 | bs = BS.empty 97 | 98 | propNullAfterDelete :: [Word16] -> Bool 99 | propNullAfterDelete xs = BS.null bs where 100 | bs :: BitSet Word16 101 | bs = foldr BS.delete (foldr BS.insert BS.empty xs) xs 102 | 103 | propIntersectionWithSelf :: [Word16] -> Bool 104 | propIntersectionWithSelf xs = all (`BS.member` bs) xs 105 | where 106 | bs :: BitSet Word16 107 | bs = let bs0 = BS.fromList xs in 108 | bs0 `BS.intersection` bs0 109 | 110 | propIntersection :: [Word16] -> Bool 111 | propIntersection xs = 112 | all (`BS.member` bs) (l `intersect` r) && 113 | all (`BS.notMember` bs) (dl `union` dr) 114 | where 115 | n = length xs 116 | (l, r) = splitAt (n `div` 2) $ nub xs 117 | 118 | dl = l \\ r 119 | dr = r \\ l 120 | 121 | bs :: BitSet Word16 122 | bs = let bs1 = BS.fromList l 123 | bs2 = BS.fromList r 124 | in bs1 `BS.intersection` bs2 125 | 126 | propDifferenceWithSelf :: [Word16] -> Bool 127 | propDifferenceWithSelf xs = bs == BS.empty where 128 | bs :: BitSet Word16 129 | bs = let bs0 = BS.fromList xs in 130 | bs0 `BS.difference` bs0 131 | 132 | propDifference :: [Word16] -> Property 133 | propDifference xs = n > 0 ==> 134 | all (`BS.member` bs) (l \\ r) && 135 | all (`BS.notMember` bs) (l `intersect` r) 136 | where 137 | n = length xs 138 | (l, r) = splitAt (n `div` 2) $ nub xs 139 | 140 | bs :: BitSet Word16 141 | bs = let bs1 = BS.fromList l 142 | bs2 = BS.fromList r 143 | in bs1 `BS.difference` bs2 144 | 145 | propMonoidLaws :: BitSet Word16 -> BitSet Word16 -> BitSet Word16 -> Bool 146 | propMonoidLaws bs1 bs2 bs3 = 147 | bs1 <> mempty == bs1 && 148 | mempty <> bs1 == bs1 && 149 | bs1 <> (bs2 <> bs3) == (bs1 <> bs2) <> bs3 150 | 151 | propIsSubsetOfSelf :: BitSet Word16 -> Bool 152 | propIsSubsetOfSelf bs = bs `BS.isSubsetOf` bs && 153 | not (bs `BS.isProperSubsetOf` bs) 154 | 155 | propIsSubsetOf :: [Word16] -> Bool 156 | propIsSubsetOf xs = 157 | bs1 `BS.isSubsetOf` bs && 158 | bs2 `BS.isSubsetOf` bs 159 | where 160 | n = length xs 161 | 162 | bs :: BitSet Word16 163 | bs = BS.fromList xs 164 | 165 | bs1 :: BitSet Word16 166 | bs1 = BS.fromList $ take (n `div` 2) xs 167 | 168 | bs2 :: BitSet Word16 169 | bs2 = BS.fromList $ drop (n `div` 2) xs 170 | 171 | propShowRead :: BitSet Word16 -> Bool 172 | propShowRead bs = bs == (read $ show bs) 173 | 174 | propMap :: BitSet Word16 -> Fun Word16' Word16 -> Property 175 | propMap bs f = BS.map (apply f . Word16') bs === (BS.fromList $ map (apply f . Word16') $ BS.toList bs) 176 | 177 | -- A little word, taking values in [0..15]. 178 | data Little = Little {getLittle :: Word} deriving (Show, Eq) 179 | 180 | mkLittle :: Word -> Little 181 | mkLittle x 182 | | 0 <= x && x < 16 = Little x 183 | | otherwise = error "Little out of range." 184 | 185 | instance Enum Little where 186 | toEnum = mkLittle . fromIntegral 187 | fromEnum = fromIntegral . getLittle 188 | 189 | instance Arbitrary Little where 190 | arbitrary = mkLittle <$> choose (0,15) 191 | 192 | instance CoArbitrary Little where 193 | coarbitrary = coarbitrary . getLittle 194 | 195 | instance Function Little where 196 | -- We use `mod` here instead of `rem` because we need a non-negative result. 197 | -- It would be nicer to use "Euclidean" division, but speed is not important. 198 | function = functionMap (fromIntegral . getLittle) (mkLittle . fromInteger . (`mod` 16)) 199 | 200 | propMapWord16 :: GS.BitSet Word16 Little -> Fun Little Little -> Property 201 | propMapWord16 bs f = GS.map (apply f) bs === (GS.fromList $ map (apply f) $ GS.toList bs) 202 | 203 | propFilter :: BitSet Word16 -> Fun Word16' Bool -> Property 204 | propFilter bs f = BS.filter (apply f . Word16') bs === (BS.fromList $ filter (apply f . Word16') $ BS.toList bs) 205 | 206 | propStorable :: GS.BitSet Word16 Word16 -> Property 207 | propStorable storable = monadicIO $ do 208 | peeked <- run $ do 209 | allocaBytes size $ \ptr -> do 210 | poke ptr storable 211 | peek ptr 212 | assert $ storable == peeked 213 | where 214 | size = sizeOf storable 215 | 216 | 217 | propPopCount :: FasterInteger -> Property 218 | propPopCount xfi = xfi >= 0 ==> popCount xfi === popCount xi where 219 | xi :: Integer 220 | xi = fromIntegral xfi 221 | 222 | propTestBit :: FasterInteger -> Int16 -> Property 223 | propTestBit xfi i = xfi >= 0 ==> testBit xfi bit == testBit xi bit where 224 | bit :: Int 225 | bit = fromIntegral i 226 | 227 | xi :: Integer 228 | xi = fromIntegral xfi 229 | 230 | propSetBit :: FasterInteger -> Int16 -> Property 231 | propSetBit xfi i = 232 | xfi >= 0 ==> setBit xfi bit == FasterInteger (setBit xi bit) 233 | where 234 | bit :: Int 235 | bit = fromIntegral i 236 | 237 | xi :: Integer 238 | xi = fromIntegral xfi 239 | 240 | propClearBit :: FasterInteger -> Int16 -> Property 241 | propClearBit xfi i = 242 | xfi >= 0 ==> 243 | classify True "x not in bs" $ 244 | clearBit xfi bit == FasterInteger (clearBit xi bit) 245 | 246 | where 247 | bit :: Int 248 | bit = fromIntegral i 249 | 250 | xi :: Integer 251 | xi = fromIntegral xfi 252 | 253 | 254 | main :: IO () 255 | main = defaultMain tests where 256 | tests :: TestTree 257 | tests = testGroup "Tests" $ [ testsBitSet, testsFasterInteger] 258 | 259 | testsBitSet :: TestTree 260 | testsBitSet = testGroup "Data.BitSet" $ 261 | [ testProperty "size" propSize 262 | , testProperty "size after insert" propSizeAfterInsert 263 | , testProperty "size after delete" propSizeAfterDelete 264 | , testProperty "insert" propInsertMember 265 | , testProperty "delete" propDeleteMember 266 | , testProperty "insert and delete are idempotent" propInsertDeleteIdempotent 267 | , testProperty "delete is idempotent" propDeleteIdempotent 268 | , testProperty "insert is idempotent" propInsertIdempotent 269 | , testProperty "toList" propToList 270 | , testProperty "fromList" propFromList 271 | , testProperty "empty" propEmpty 272 | , testProperty "native empty is null" propNullEmpty 273 | , testProperty "generated empty is null" propNullAfterDelete 274 | , testProperty "intersection with self" propIntersectionWithSelf 275 | , testProperty "intersection" propIntersection 276 | , testProperty "difference with self" propDifferenceWithSelf 277 | , testProperty "difference" propDifference 278 | , testProperty "monoid laws" propMonoidLaws 279 | , testProperty "is subset of self" propIsSubsetOfSelf 280 | , testProperty "is subset of" propIsSubsetOf 281 | , testProperty "show read" propShowRead 282 | , testProperty "map Word16" propMapWord16 283 | , testProperty "map" propMap 284 | , testProperty "filter" propFilter 285 | , testProperty "storable instance" propStorable 286 | ] 287 | 288 | testsFasterInteger :: TestTree 289 | testsFasterInteger = testGroup "GHC.Integer.GMP" $ 290 | [ 291 | testProperty "pop count" propPopCount 292 | , testProperty "test bit" propTestBit 293 | , testProperty "set bit" propSetBit 294 | , testProperty "clear bit" propClearBit 295 | ] 296 | -------------------------------------------------------------------------------- /travis.sh: -------------------------------------------------------------------------------- 1 | #! /bin/bash 2 | 3 | set -e 4 | 5 | cabal configure --enable-tests --enable-benchmarks 6 | cabal build 7 | cabal test 8 | 9 | cabal bench --benchmark-options='-o index.html -G -s500' 10 | 11 | cabal configure 12 | cabal install hscolour 13 | cabal haddock --hyperlink-source --html-location='http://hackage.haskell.org/packages/archive/$pkg/$version/doc/html' 14 | 15 | exec > /dev/null 2>&1 16 | 17 | git config --global user.name "Travis CI" 18 | git config --global user.email "ci+bitset@knsd.net" 19 | 20 | git clone https://${GH_TOKEN}@github.com/lambda-llama/bitset.git 21 | 22 | cd bitset 23 | git checkout -b gh-pages origin/gh-pages 24 | 25 | mv ../index.html benchmarks/index.html 26 | git add benchmarks 27 | 28 | rm -rf docs 29 | mv ../dist/doc/html/bitset docs 30 | git add docs 31 | 32 | git commit -m "Travis build $TRAVIS_BUILD_NUMBER" 33 | git push 34 | --------------------------------------------------------------------------------