diff --git a/doctest/DoctestDriver.hs b/doctest/DoctestDriver.hs new file mode 100644 --- /dev/null +++ b/doctest/DoctestDriver.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE CPP #-} + +#if MIN_VERSION_GLASGOW_HASKELL(8,4,4,0) +{-# OPTIONS_GHC -F -pgmF doctest-discover #-} +#else +module Main where + +import qualified System.IO as IO + +main :: IO () +main = IO.putStrLn "WARNING: doctest will not run on GHC versions earlier than 8.4.4" +#endif diff --git a/hw-bits.cabal b/hw-bits.cabal --- a/hw-bits.cabal +++ b/hw-bits.cabal @@ -1,7 +1,7 @@ cabal-version: 2.2 name: hw-bits -version: 0.7.1.0 +version: 0.7.1.1 synopsis: Bit manipulation description: Please see README.md category: Data, Bit @@ -26,29 +26,33 @@ manual: False default: True -common base { build-depends: base >= 4 && < 5 } +common base { build-depends: base >= 4 && < 5 } -common bitvec { build-depends: bitvec >= 1.0 && < 1.1 } -common bytestring { build-depends: bytestring >= 0.9 && < 0.11 } -common criterion { build-depends: criterion >= 1.2 && < 1.6 } -common deepseq { build-depends: deepseq >= 1.4 && < 1.5 } -common hedgehog { build-depends: hedgehog >= 0.6 && < 1.1 } -common hspec { build-depends: hspec >= 2.4 && < 3 } -common hw-hspec-hedgehog { build-depends: hw-hspec-hedgehog >= 0.1.0.4 && < 0.2 } -common hw-int { build-depends: hw-int >= 0.0.0.1 && < 0.1 } -common hw-prim { build-depends: hw-prim >= 0.4.0.3 && < 0.7 } -common hw-string-parse { build-depends: hw-string-parse >= 0.0.0.1 && < 0.1 } -common vector { build-depends: vector >= 0.12 && < 0.13 } +common bitvec { build-depends: bitvec >= 1.0 && < 1.1 } +common bytestring { build-depends: bytestring >= 0.9 && < 0.11 } +common criterion { build-depends: criterion >= 1.2 && < 1.6 } +common deepseq { build-depends: deepseq >= 1.4 && < 1.5 } +common doctest { build-depends: doctest >= 0.16.2 && < 0.17 } +common doctest-discover { build-depends: doctest-discover >= 0.2 && < 0.3 } +common hedgehog { build-depends: hedgehog >= 0.6 && < 1.1 } +common hspec { build-depends: hspec >= 2.4 && < 3 } +common hw-hspec-hedgehog { build-depends: hw-hspec-hedgehog >= 0.1.0.4 && < 0.2 } +common hw-int { build-depends: hw-int >= 0.0.0.1 && < 0.1 } +common hw-prim { build-depends: hw-prim >= 0.4.0.3 && < 0.7 } +common hw-string-parse { build-depends: hw-string-parse >= 0.0.0.1 && < 0.1 } +common vector { build-depends: vector >= 0.12 && < 0.13 } -common common +common hw-bits + build-depends: hw-bits + +common config default-language: Haskell2010 ghc-options: -Wall -O2 if flag(sse42) ghc-options: -msse4.2 library - import: base - , common + import: base, config , bitvec , bytestring , deepseq @@ -84,39 +88,44 @@ hs-source-dirs: src test-suite hw-bits-test - import: base - , common + import: base, config , bitvec , bytestring , hedgehog , hspec + , hw-bits , hw-hspec-hedgehog , hw-prim , vector - build-depends: hw-bits type: exitcode-stdio-1.0 main-is: Spec.hs - build-depends: hw-bits other-modules: HaskellWorks.Data.Bits.BitReadSpec HaskellWorks.Data.Bits.BitWiseSpec HaskellWorks.Data.Bits.FromBitTextByteStringSpec HaskellWorks.Data.Bits.Log2Spec HaskellWorks.Data.Bits.Writer.StorableSpec - Paths_hw_bits - autogen-modules: Paths_hw_bits hs-source-dirs: test ghc-options: -threaded -rtsopts -with-rtsopts=-N build-tool-depends: hspec-discover:hspec-discover benchmark bench - import: base - , common + import: base, config , criterion + , hw-bits , vector - build-depends: hw-bits type: exitcode-stdio-1.0 main-is: Main.hs - build-depends: hw-bits - other-modules: Paths_hw_bits - autogen-modules: Paths_hw_bits hs-source-dirs: bench + +test-suite doctest + import: base, config + , doctest + , doctest-discover + , hw-bits + , vector + default-language: Haskell2010 + type: exitcode-stdio-1.0 + ghc-options: -threaded + main-is: DoctestDriver.hs + HS-Source-Dirs: doctest + build-tool-depends: doctest-discover:doctest-discover diff --git a/src/HaskellWorks/Data/Bits/Broadword.hs b/src/HaskellWorks/Data/Bits/Broadword.hs --- a/src/HaskellWorks/Data/Bits/Broadword.hs +++ b/src/HaskellWorks/Data/Bits/Broadword.hs @@ -30,6 +30,21 @@ broadword (Broadword a) = a {-# INLINE broadword #-} +-- | Initialise all sub-words of size k where 'k' ∈ { 2, 4, 8, 16, 32, 64 } such that the lowest bit is set to 1 and all other bits are cleared. +-- +-- >>> import Numeric(showHex) +-- >>> showHex (l 2) "" +-- "5555555555555555" +-- >>> showHex (l 4) "" +-- "1111111111111111" +-- >>> showHex (l 8) "" +-- "101010101010101" +-- >>> showHex (l 16) "" +-- "1000100010001" +-- >>> showHex (l 32) "" +-- "100000001" +-- >>> showHex (l 64) "" +-- "1" l :: Int -> Word64 l 2 = 0x5555555555555555 l 4 = 0x1111111111111111 @@ -40,6 +55,21 @@ l k = error ("Invalid h k where k = " ++ show k) {-# INLINE l #-} +-- | Initialise all sub-words of size k where 'k' ∈ { 2, 4, 8, 16, 32, 64 } such that the highest bit is set to 1 and all other bits are cleared. +-- +-- >>> import Numeric(showHex) +-- >>> showHex (h 2) "" +-- "aaaaaaaaaaaaaaaa" +-- >>> showHex (h 4) "" +-- "8888888888888888" +-- >>> showHex (h 8) "" +-- "8080808080808080" +-- >>> showHex (h 16) "" +-- "8000800080008000" +-- >>> showHex (h 32) "" +-- "8000000080000000" +-- >>> showHex (h 64) "" +-- "8000000000000000" h :: Int -> Word64 h 2 = 0xaaaaaaaaaaaaaaaa h 4 = 0x8888888888888888 @@ -50,18 +80,59 @@ h k = error ("Invalid h k where k = " ++ show k) {-# INLINE h #-} +-- | Broadword subtraction of sub-words of size 'k' where 'k' ∈ { 2, 4, 8, 16, 32, 64 }. +-- +-- The subtraction respects 2's complement so sub-words may be regarded as signed or unsigned words. +-- +-- >>> import Numeric(showHex) +-- >>> showHex (kBitDiff 8 0x0807060504030201 0x0404030302020101) "" +-- "403030202010100" +-- >>> showHex (kBitDiff 8 0x0807060504030201 0x0102030405060708) "" +-- "7050301fffdfbf9" +-- >>> showHex (kBitDiff 8 0x20000000000000ff 0x10000000000000ff) "" +-- "1000000000000000" kBitDiff :: Int -> Word64 -> Word64 -> Word64 kBitDiff k x y = ((x .|. h k) - (y .&. comp (h k))) .^. ((x .^. comp y) .&. h k) {-# INLINE kBitDiff #-} +-- | Broadword subtraction of sub-words of size 'k' where 'k' ∈ { 2, 4, 8, 16, 32, 64 } where results are bounded from below by 0. +-- +-- >>> import Numeric(showHex) +-- >>> showHex (kBitDiffPos 8 0x0807060504030201 0x0404030302020101) "" +-- "403030202010100" +-- >>> showHex (kBitDiffPos 8 0x0807060504030201 0x0102030405060708) "" +-- "705030100000000" +-- >>> showHex (kBitDiffPos 8 0x20000000000000ff 0x10000000000000ff) "" +-- "1000000000000000" kBitDiffPos :: Int -> Word64 -> Word64 -> Word64 -kBitDiffPos k x y = let d = kBitDiff k x y in d .&. ((d .>. fromIntegral (k - 1)) - 1) +kBitDiffPos k x y = let d = kBitDiff k x y in d .&. kBitDiff k 0 ((comp d .&. h 8) .>. fromIntegral (k - 1)) {-# INLINE kBitDiffPos #-} +-- | Broadword subtraction of sub-words of size 'k' where 'k' ∈ { 2, 4, 8, 16, 32, 64 } where all the sub-words of 'x' and 'y' must +-- not have the signed bit set for the result to be meaningful. +-- +-- >>> import Numeric(showHex) +-- >>> showHex (kBitDiffUnsafe 8 0x0807060504030201 0x0404030302020101) "" +-- "403030202010100" +-- >>> showHex (kBitDiffUnsafe 8 0x0807060504030201 0x0102030405060708) "" +-- "7050301fffdfbf9" +-- >>> showHex (kBitDiffUnsafe 8 0x20000000000000ff 0x10000000000000ff) "" +-- "1000000000000080" kBitDiffUnsafe :: Int -> Word64 -> Word64 -> Word64 kBitDiffUnsafe k x y = ((x .|. h k) - y) .^. h k {-# INLINE kBitDiffUnsafe #-} +-- | Returns the position of the least significant bit (0-based). +-- +-- This is equivalent to 'DB.countTrailingZeros' except for when there are no bits set. In which case +-- return a word with all bits set. +-- +-- >>> lsb 8 +-- 3 +-- >>> lsb 1 +-- 0 +-- >>> lsb 0 +-- 18446744073709551615 lsb :: Word64 -> Word64 lsb w = let r = fromIntegral (DB.countTrailingZeros w) in r .|. negate ((r .>. 6) .&. 0x1) {-# INLINE lsb #-} diff --git a/src/HaskellWorks/Data/Bits/ElemFixedBitSize.hs b/src/HaskellWorks/Data/Bits/ElemFixedBitSize.hs --- a/src/HaskellWorks/Data/Bits/ElemFixedBitSize.hs +++ b/src/HaskellWorks/Data/Bits/ElemFixedBitSize.hs @@ -1,4 +1,5 @@ {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} module HaskellWorks.Data.Bits.ElemFixedBitSize @@ -16,14 +17,14 @@ -- | Class of values that have elements of a fixed bit size -- --- >>> elemFixedBitSize (Vector Word8) +-- >>> elemFixedBitSize (undefined :: DVS.Vector Word8) -- 8 class ElemFixedBitSize v where -- | The element type of the elemnet type Elem v -- | Get the bit size of an element for a given composite bit-string type. -- - -- >>> elemFixedBitSize (Vector Word8) + -- >>> elemFixedBitSize (undefined :: DVS.Vector Word8) -- 8 elemFixedBitSize :: v -> Count diff --git a/src/HaskellWorks/Data/Bits/FixedBitSize.hs b/src/HaskellWorks/Data/Bits/FixedBitSize.hs --- a/src/HaskellWorks/Data/Bits/FixedBitSize.hs +++ b/src/HaskellWorks/Data/Bits/FixedBitSize.hs @@ -9,7 +9,7 @@ class FixedBitSize a where -- | Get the bit size of a value of given type. -- - -- >>> fixedBitSize Word8 + -- >>> fixedBitSize (undefined :: Word8) -- 8 fixedBitSize :: a -> Count diff --git a/test/HaskellWorks/Data/Bits/BitReadSpec.hs b/test/HaskellWorks/Data/Bits/BitReadSpec.hs --- a/test/HaskellWorks/Data/Bits/BitReadSpec.hs +++ b/test/HaskellWorks/Data/Bits/BitReadSpec.hs @@ -15,7 +15,7 @@ import qualified Data.Vector as DV import qualified Data.Vector.Unboxed as DVU -{-# ANN module ("HLint: Ignore Redundant do" :: String) #-} +{-# ANN module ("HLint: ignore Redundant do" :: String) #-} spec :: Spec spec = describe "HaskellWorks.Data.BitReadSpec" $ do diff --git a/test/HaskellWorks/Data/Bits/FromBitTextByteStringSpec.hs b/test/HaskellWorks/Data/Bits/FromBitTextByteStringSpec.hs --- a/test/HaskellWorks/Data/Bits/FromBitTextByteStringSpec.hs +++ b/test/HaskellWorks/Data/Bits/FromBitTextByteStringSpec.hs @@ -17,7 +17,7 @@ import qualified Data.Vector.Storable as DVS import qualified Data.Vector.Unboxed as DVU -{-# ANN module ("HLint: Ignore Redundant do" :: String) #-} +{-# ANN module ("HLint: ignore Redundant do" :: String) #-} spec :: Spec spec = describe "HaskellWorks.Data.Bits.FromBitTextByteStringSpec" $ do diff --git a/test/HaskellWorks/Data/Bits/Log2Spec.hs b/test/HaskellWorks/Data/Bits/Log2Spec.hs --- a/test/HaskellWorks/Data/Bits/Log2Spec.hs +++ b/test/HaskellWorks/Data/Bits/Log2Spec.hs @@ -11,7 +11,7 @@ import qualified Hedgehog.Gen as G import qualified Hedgehog.Range as R -{-# ANN module ("HLint: Ignore Redundant do" :: String) #-} +{-# ANN module ("HLint: ignore Redundant do" :: String) #-} spec :: Spec spec = describe "HaskellWorks.Data.Bits.Log2Spec" $ do diff --git a/test/HaskellWorks/Data/Bits/Writer/StorableSpec.hs b/test/HaskellWorks/Data/Bits/Writer/StorableSpec.hs --- a/test/HaskellWorks/Data/Bits/Writer/StorableSpec.hs +++ b/test/HaskellWorks/Data/Bits/Writer/StorableSpec.hs @@ -11,7 +11,7 @@ import qualified Data.Vector.Storable as DVS import qualified HaskellWorks.Data.Bits.Writer.Storable as WS -{-# ANN module ("HLint: Ignore Redundant do" :: String) #-} +{-# ANN module ("HLint: ignore Redundant do" :: String) #-} spec :: Spec spec = describe "HaskellWorks.Data.Bits.Writer.StorableSpec" $ do