diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c)2012, Claude Heiland-Allen +Copyright (c)2012,2016,2018, Claude Heiland-Allen All rights reserved. diff --git a/README b/README --- a/README +++ b/README @@ -1,8 +1,9 @@ Interactive interpreted usage without having installed first requires adding a search path for the respective environment: - hugs -98 -P:src:hugs98 - ghci-7.0.4 -isrc:ghc70 - ghci-7.4.1 -isrc:ghc74 + hugs -98 -P:src:base21 + ghci-7.0.4 -isrc:base40 + ghci-7.4.1 -isrc:base45 + ghci-7.8.1 -isrc:base47 -ghc < 7 has not been tested, reports welcome. +ghc < 7.6 has not been tested recently, reports welcome. diff --git a/base21/Compat.hs b/base21/Compat.hs new file mode 100644 --- /dev/null +++ b/base21/Compat.hs @@ -0,0 +1,29 @@ +module Compat + ( unsafeIOToST + , uncons + , packCStringLen + , unsafeUseAsCStringLen + , popCount + , zeroBits + ) where + +import Control.Monad.ST (unsafeIOToST) +import Data.Bits (Bits, (.&.), shiftR, clearBit, bit) +import qualified Data.ByteString as BS +import Data.Word (Word8, Word64) +import Foreign.C.String (CStringLen) + +uncons :: BS.ByteString -> Maybe (Word8, BS.ByteString) +uncons s = if BS.null s then Nothing else Just (BS.head s, BS.tail s) + +unsafeUseAsCStringLen :: BS.ByteString -> (CStringLen -> IO a) -> IO a +unsafeUseAsCStringLen = BS.useAsCStringLen + +packCStringLen :: CStringLen -> IO BS.ByteString +packCStringLen = return . BS.packCStringLen + +popCount :: Word64 -> Int +popCount = fromIntegral . sum . map (.&. 1) . take 64 . iterate (`shiftR` 1) + +zeroBits :: Bits b => b +zeroBits = clearBit (bit 0) 0 diff --git a/base40/Compat.hs b/base40/Compat.hs new file mode 100644 --- /dev/null +++ b/base40/Compat.hs @@ -0,0 +1,19 @@ +module Compat + ( unsafeIOToST + , uncons + , packCStringLen + , unsafeUseAsCStringLen + , popCount + , zeroBits + ) where + +import Control.Monad.ST (unsafeIOToST) +import Data.ByteString (uncons, packCStringLen) +import Data.ByteString.Unsafe (unsafeUseAsCStringLen) +import Data.Bits (Bits, (.&.), shiftR, clearBit, bit) + +popCount :: Word64 -> Int +popCount = fromIntegral . sum . map (.&. 1) . take 64 . iterate (`shiftR` 1) + +zeroBits :: Bits b => b +zeroBits = clearBit (bit 0) 0 diff --git a/base45/Compat.hs b/base45/Compat.hs new file mode 100644 --- /dev/null +++ b/base45/Compat.hs @@ -0,0 +1,16 @@ +module Compat + ( unsafeIOToST + , uncons + , packCStringLen + , unsafeUseAsCStringLen + , popCount + , zeroBits + ) where + +import Control.Monad.ST.Unsafe (unsafeIOToST) +import Data.ByteString (uncons, packCStringLen) +import Data.ByteString.Unsafe (unsafeUseAsCStringLen) +import Data.Bits (Bits, popCount, clearBit, bit) + +zeroBits :: Bits b => b +zeroBits = clearBit (bit 0) 0 diff --git a/base47/Compat.hs b/base47/Compat.hs new file mode 100644 --- /dev/null +++ b/base47/Compat.hs @@ -0,0 +1,13 @@ +module Compat + ( unsafeIOToST + , uncons + , packCStringLen + , unsafeUseAsCStringLen + , popCount + , zeroBits + ) where + +import Control.Monad.ST.Unsafe (unsafeIOToST) +import Data.ByteString (uncons, packCStringLen) +import Data.ByteString.Unsafe (unsafeUseAsCStringLen) +import Data.Bits (popCount, zeroBits) diff --git a/bitwise.cabal b/bitwise.cabal --- a/bitwise.cabal +++ b/bitwise.cabal @@ -1,5 +1,5 @@ Name: bitwise -Version: 0.1.1.1 +Version: 0.2 Synopsis: fast multi-dimensional unboxed bit packed Bool arrays Description: Unboxed multidimensional bit packed Bool arrays with fast aggregate @@ -45,18 +45,23 @@ * immutable zipWith @Bool -> Bool -> Bool@: @BitArray ix@ is about 1300x faster than @UArray ix Bool@. -Homepage: http://code.mathr.co.uk/bitwise +Homepage: https://code.mathr.co.uk/bitwise License: BSD3 License-file: LICENSE Author: Claude Heiland-Allen Maintainer: claude@mathr.co.uk -Copyright: (c) 2012,2016 Claude Heiland-Allen +Copyright: (c) 2012,2016,2018 Claude Heiland-Allen Category: Data, Data Structures, Bit Vectors Build-type: Simple Cabal-version: >= 1.9.2 -Extra-source-files: README hugs98/Compat.hs ghc70/Compat.hs ghc74/Compat.hs +Extra-source-files: + README + base21/Compat.hs + base40/Compat.hs + base45/Compat.hs + base47/Compat.hs Library Exposed-modules: @@ -72,44 +77,52 @@ Compat Build-depends: - base >= 2 && < 4.10 + bytestring < 0.11, + array < 0.6 - if (impl(ghc >= 7.4)) - HS-source-dirs: src ghc74 - Build-depends: bytestring, array + HS-source-dirs: src + if (impl(hugs)) + HS-source-dirs: base21 + Build-depends: base >= 2.1 && < 4.0 + if (impl(ghc < 7.4)) - HS-source-dirs: src ghc70 - Build-depends: bytestring, array + HS-source-dirs: base40 + Build-depends: base >= 4.0 && < 4.5 - if (impl(hugs)) - HS-source-dirs: src hugs98 + if (impl(ghc >= 7.4) && impl(ghc < 7.8)) + HS-source-dirs: base45 + Build-depends: base >= 4.5 && < 4.7 + if (impl(ghc >= 7.8)) + HS-source-dirs: base47 + Build-depends: base >= 4.7 && < 4.12 + GHC-Options: -Wall Test-Suite bitwise-testsuite type: exitcode-stdio-1.0 main-is: extra/testsuite.hs build-depends: - bitwise == 0.1.1.1, - base >= 2 && < 4.10, - QuickCheck >= 2.4 && < 2.9 + bitwise, + base, + QuickCheck >= 2.4 && < 2.12 Benchmark bitwise-benchmark - type: exitcode-stdio-1.0 + type: exitcode-stdio-1.0 main-is: extra/benchmark.hs build-depends: - bitwise == 0.1.1.1, - base >= 2 && < 4.10, + bitwise, + base, array, bytestring, - criterion >= 0.6 && < 1.2 + criterion >= 0.6 && < 1.5 source-repository head type: git - location: http://code.mathr.co.uk/bitwise.git + location: https://code.mathr.co.uk/bitwise.git source-repository this type: git - location: http://code.mathr.co.uk/bitwise.git - tag: v0.1.1.1 + location: https://code.mathr.co.uk/bitwise.git + tag: v0.2 diff --git a/ghc70/Compat.hs b/ghc70/Compat.hs deleted file mode 100644 --- a/ghc70/Compat.hs +++ /dev/null @@ -1,15 +0,0 @@ -module Compat - ( unsafeIOToST - , uncons - , packCStringLen - , unsafeUseAsCStringLen - , popCount - ) where - -import Control.Monad.ST (unsafeIOToST) -import Data.ByteString (uncons, packCStringLen) -import Data.ByteString.Unsafe (unsafeUseAsCStringLen) -import Data.Bits ((.&.), shiftR) - -popCount :: Word64 -> Int -popCount = fromIntegral . sum . map (.&. 1) . take 64 . iterate (`shiftR` 1) diff --git a/ghc74/Compat.hs b/ghc74/Compat.hs deleted file mode 100644 --- a/ghc74/Compat.hs +++ /dev/null @@ -1,12 +0,0 @@ -module Compat - ( unsafeIOToST - , uncons - , packCStringLen - , unsafeUseAsCStringLen - , popCount - ) where - -import Control.Monad.ST.Unsafe (unsafeIOToST) -import Data.ByteString (uncons, packCStringLen) -import Data.ByteString.Unsafe (unsafeUseAsCStringLen) -import Data.Bits (popCount) diff --git a/hugs98/Compat.hs b/hugs98/Compat.hs deleted file mode 100644 --- a/hugs98/Compat.hs +++ /dev/null @@ -1,25 +0,0 @@ -module Compat - ( unsafeIOToST - , uncons - , packCStringLen - , unsafeUseAsCStringLen - , popCount - ) where - -import Control.Monad.ST (unsafeIOToST) -import Data.Bits ((.&,), shiftR) -import qualified Data.ByteString as BS -import Data.Word (Word8) -import Foreign.C.String (CStringLen) - -uncons :: BS.ByteString -> Maybe (Word8, BS.ByteString) -uncons s = if BS.null s then Nothing else Just (BS.head s, BS.tail s) - -unsafeUseAsCStringLen :: BS.ByteString -> (CStringLen -> IO a) -> IO a -unsafeUseAsCStringLen = BS.useAsCStringLen - -packCStringLen :: CStringLen -> IO BS.ByteString -packCStringLen = return . BS.packCStringLen - -popCount :: Word64 -> Int -popCount = fromIntegral . sum . map (.&. 1) . take 64 . iterate (`shiftR` 1) diff --git a/src/Codec/Image/PBM.hs b/src/Codec/Image/PBM.hs --- a/src/Codec/Image/PBM.hs +++ b/src/Codec/Image/PBM.hs @@ -3,7 +3,7 @@ {-| Module : Codec.Image.PBM -Copyright : (c) Claude Heiland-Allen 2012 +Copyright : (c) Claude Heiland-Allen 2012,2018 License : BSD3 Maintainer : claude@mathr.co.uk @@ -55,7 +55,7 @@ import qualified Data.ByteString as BS import qualified Compat as BSC -import Data.Bits.Bitwise (fromListBE, toListLE) +import Data.Bits.Bitwise (packWord8BE, unpackWord8LE) import Data.Array.BitArray (BitArray, bounds, elems, listArray, false, (//), assocs, ixmap) import Data.Array.BitArray.ByteString (toByteString, fromByteString) @@ -293,7 +293,8 @@ -- | A slow way to reverse bit order. bitReverse :: Word8 -> Word8 -bitReverse = fromListBE . toListLE +bitReverse w = case unpackWord8LE w of + (a, b, c, d, e, f, g, h) -> packWord8BE a b c d e f g h -- | White space characters as defined by the PBM specification. pbmSpace :: String diff --git a/src/Data/Bits/Bitwise.hs b/src/Data/Bits/Bitwise.hs --- a/src/Data/Bits/Bitwise.hs +++ b/src/Data/Bits/Bitwise.hs @@ -44,15 +44,17 @@ import Prelude hiding (repeat, map, zipWith, any, all, or, and, splitAt) import qualified Prelude as P +import Compat (zeroBits) + import Data.Bits (Bits(complement, (.&.), (.|.), xor, bit, shiftL, shiftR, testBit, bitSize)) import Data.List (foldl') import Data.Word (Word8) -- | Lift a boolean constant to a bitwise constant. {-# INLINE repeat #-} -repeat :: (Num b, Bits b) => Bool -> b -repeat False = 0 -repeat True = complement 0 +repeat :: (Bits b) => Bool -> b +repeat False = zeroBits +repeat True = complement zeroBits -- | Lift a unary boolean operation to a bitwise operation. -- @@ -60,12 +62,12 @@ -- thus the operation provided must be total. -- {-# INLINE map #-} -map :: (Num b, Bits b) => (Bool -> Bool) {- ^ operation -} -> b -> b +map :: (Bits b) => (Bool -> Bool) {- ^ operation -} -> b -> b map f = case (f False, f True) of - (False, False) -> \_ -> 0 + (False, False) -> \_ -> zeroBits (False, True ) -> id (True, False) -> complement - (True, True ) -> \_ -> complement 0 + (True, True ) -> \_ -> complement zeroBits -- | Lift a binary boolean operation to a bitwise operation. -- @@ -73,9 +75,9 @@ -- thus the operation provided must be total. -- {-# INLINE zipWith #-} -zipWith :: (Num b, Bits b) => (Bool -> Bool -> Bool) {- ^ operation -} -> b -> b -> b +zipWith :: (Bits b) => (Bool -> Bool -> Bool) {- ^ operation -} -> b -> b -> b zipWith f = case (f False False, f False True, f True False, f True True) of - (False, False, False, False) -> \_ _ -> 0 + (False, False, False, False) -> \_ _ -> zeroBits (False, False, False, True ) -> (.&.) (False, False, True, False) -> \x y -> x .&. complement y (False, False, True, True ) -> \x _ -> x @@ -90,37 +92,37 @@ (True, True, False, False) -> \x _ -> complement x (True, True, False, True ) -> \x y -> complement x .|. y (True, True, True, False) -> \x y -> complement (x .&. y) - (True, True, True, True ) -> \_ _ -> complement 0 + (True, True, True, True ) -> \_ _ -> complement zeroBits -- zipWith3 would have 256 cases? not sure.. -- | True when any bit is set. {-# INLINE or #-} -or :: (Num b, Bits b) => b -> Bool -or b = b /= 0 +or :: (Bits b) => b -> Bool +or b = b /= zeroBits -- | True when all bits are set. {-# INLINE and #-} -and :: (Num b, Bits b) => b -> Bool -and b = b == complement 0 +and :: (Bits b) => b -> Bool +and b = b == complement zeroBits -- | True when the predicate is true for any bit. {-# INLINE any #-} -any :: (Num b, Bits b) => (Bool -> Bool) {- ^ predicate -} -> b -> Bool +any :: (Bits b) => (Bool -> Bool) {- ^ predicate -} -> b -> Bool any f = or . map f -- | True when the predicate is true for all bits. {-# INLINE all #-} -all :: (Num b, Bits b) => (Bool -> Bool) {- ^ predicate -} -> b -> Bool +all :: (Bits b) => (Bool -> Bool) {- ^ predicate -} -> b -> Bool all f = and . map f -- | Determine if a 'Bits' is all 1s, all 0s, or neither. {-# INLINE isUniform #-} -isUniform :: (Num b, Bits b) => b -> Maybe Bool +isUniform :: (Bits b) => b -> Maybe Bool isUniform b - | b == 0 = Just False - | b == complement 0 = Just True - | otherwise = Nothing + | b == zeroBits = Just False + | b == complement zeroBits = Just True + | otherwise = Nothing -- | A mask with count least significant bits set. {-# INLINE mask #-} @@ -136,7 +138,7 @@ -- | Join lsb with msb to make a word. Assumes lsb has no set bits -- above the join point. {-# INLINE joinAt #-} -joinAt :: (Num b, Bits b) => Int {- ^ join point -} -> b {- ^ least significant bits -} -> b {- ^ most significant bits -} -> b {- ^ word -} +joinAt :: (Bits b) => Int {- ^ join point -} -> b {- ^ least significant bits -} -> b {- ^ most significant bits -} -> b {- ^ word -} joinAt n lsb msb = lsb .|. (msb `shiftL` n) -- | Pack bits into a byte in little-endian order. @@ -165,32 +167,32 @@ -- | The least significant bit. {-# INLINE fromBool #-} -fromBool :: (Num b, Bits b) => Bool -> b -fromBool False = 0 +fromBool :: (Bits b) => Bool -> b +fromBool False = zeroBits fromBool True = bit 0 -- | Convert a little-endian list of bits to 'Bits'. {-# INLINE fromListLE #-} -fromListLE :: (Num b, Bits b) => [Bool] {- ^ \[least significant bit, ..., most significant bit\] -} -> b -fromListLE = foldr f 0 +fromListLE :: (Bits b) => [Bool] {- ^ \[least significant bit, ..., most significant bit\] -} -> b +fromListLE = foldr f zeroBits where f b i = fromBool b .|. (i `shiftL` 1) -- | Convert a 'Bits' (with a defined 'bitSize') to a list of bits, in -- little-endian order. {-# INLINE toListLE #-} -toListLE :: (Num b, Bits b) => b -> [Bool] {- ^ \[least significant bit, ..., most significant bit\] -} +toListLE :: (Bits b) => b -> [Bool] {- ^ \[least significant bit, ..., most significant bit\] -} toListLE b = P.map (testBit b) [0 .. bitSize b - 1] -- | Convert a big-endian list of bits to 'Bits'. {-# INLINE fromListBE #-} -fromListBE :: (Num b, Bits b) => [Bool] {- ^ \[most significant bit, ..., least significant bit\] -} -> b -fromListBE = foldl' f 0 +fromListBE :: (Bits b) => [Bool] {- ^ \[most significant bit, ..., least significant bit\] -} -> b +fromListBE = foldl' f zeroBits where f i b = (i `shiftL` 1) .|. fromBool b -- | Convert a 'Bits' (with a defined 'bitSize') to a list of bits, in -- big-endian order. {-# INLINE toListBE #-} -toListBE :: (Num b, Bits b) => b -> [Bool] {- ^ \[most significant bit, ..., least significant bit\] -} +toListBE :: (Bits b) => b -> [Bool] {- ^ \[most significant bit, ..., least significant bit\] -} toListBE b = P.map (testBit b) [bitSize b - 1, bitSize b - 2 .. 0]