wide-word 0.1.5.0 → 0.1.6.0
raw patch · 8 files changed
+86/−30 lines, 8 filesdep ~QuickCheckdep ~basedep ~bytestring
Dependency ranges changed: QuickCheck, base, bytestring, hashable, hedgehog
Files
- ChangeLog.md +4/−0
- src/Data/WideWord/Int128.hs +16/−5
- src/Data/WideWord/Word128.hs +18/−5
- src/Data/WideWord/Word256.hs +19/−4
- src/Data/WideWord/Word64.hs +1/−0
- test/Test/Data/WideWord/Int128.hs +7/−0
- test/Test/Data/WideWord/Word128.hs +13/−8
- wide-word.cabal +8/−8
ChangeLog.md view
@@ -1,5 +1,9 @@ # Revision history for wide-word +## 0.1.6.0 -- 2023-10-24++* Fixes for shifting/rotating by negative values.+ ## 0.1.5.0 -- 2023-01-14 * Add Binary instances for Int128, Word128 and Word256.
src/Data/WideWord/Int128.hs view
@@ -341,31 +341,38 @@ xor128 (Int128 a1 a0) (Int128 b1 b0) = Int128 (xor a1 b1) (xor a0 b0) --- Probably not worth inlining this.+-- Some of the following functions have quite complicated guard clauses, but we make them+-- inlineable anyway so that if the things like the shift amount is a compile time constant+-- most of the function can be dropped leaving only the needed bits inlined.++{-# INLINABLE shiftL128 #-} shiftL128 :: Int128 -> Int -> Int128 shiftL128 w@(Int128 a1 a0) s | s == 0 = w- | s < 0 = shiftL128 w (128 - (abs s `mod` 128))+ | s == minBound = zeroInt128+ | s < 0 = shiftR128 w (negate s) | s >= 128 = zeroInt128 | s == 64 = Int128 a0 0 | s > 64 = Int128 (a0 `shiftL` (s - 64)) 0 | otherwise = Int128 (a1 `shiftL` s + a0 `shiftR` (64 - s)) (a0 `shiftL` s) --- Probably not worth inlining this.+{-# INLINABLE shiftR128 #-} shiftR128 :: Int128 -> Int -> Int128 shiftR128 i@(Int128 a1 a0) s- | s < 0 = zeroInt128 | s == 0 = i+ | s == minBound = zeroInt128+ | s < 0 = shiftL128 i (negate s) | topBitSetWord64 a1 = complement128 (shiftR128 (complement128 i) s) | s >= 128 = zeroInt128 | s == 64 = Int128 0 a1 | s > 64 = Int128 0 (a1 `shiftR` (s - 64)) | otherwise = Int128 (a1 `shiftR` s) (a0 `shiftR` s + a1 `shiftL` (64 - s)) +{-# INLINABLE rotateL128 #-} rotateL128 :: Int128 -> Int -> Int128 rotateL128 w@(Int128 a1 a0) r- | r < 0 = zeroInt128+ | r < 0 = rotateL128 w (128 - (abs r `mod` 128)) | r == 0 = w | r >= 128 = rotateL128 w (r `mod` 128) | r == 64 = Int128 a0 a1@@ -373,6 +380,7 @@ | otherwise = Int128 (a1 `shiftL` r + a0 `shiftR` (64 - r)) (a0 `shiftL` r + a1 `shiftR` (64 - r)) +{-# INLINABLE rotateR128 #-} rotateR128 :: Int128 -> Int -> Int128 rotateR128 w@(Int128 a1 a0) r | r < 0 = rotateR128 w (128 - (abs r `mod` 128))@@ -383,6 +391,7 @@ | otherwise = Int128 (a1 `shiftR` r + a0 `shiftL` (64 - r)) (a0 `shiftR` r + a1 `shiftL` (64 - r)) +{-# INLINABLE testBit128 #-} testBit128 :: Int128 -> Int -> Bool testBit128 (Int128 a1 a0) i | i < 0 = False@@ -390,12 +399,14 @@ | i >= 64 = testBit a1 (i - 64) | otherwise = testBit a0 i +{-# INLINABLE bit128 #-} bit128 :: Int -> Int128 bit128 indx | indx < 0 = zeroInt128 | indx >= 128 = zeroInt128 | otherwise = shiftL128 oneInt128 indx +{-# INLINABLE popCount128 #-} popCount128 :: Int128 -> Int popCount128 (Int128 a1 a0) = popCount a1 + popCount a0
src/Data/WideWord/Word128.hs view
@@ -324,11 +324,16 @@ complement128 :: Word128 -> Word128 complement128 (Word128 a1 a0) = Word128 (complement a1) (complement a0) --- Probably not worth inlining this.+-- Some of the following functions have quite complicated guard clauses, but we make them+-- inlineable anyway so that if the things like the shift amount is a compile time constant+-- most of the function can be dropped leaving only the needed bits inlined.++{-# INLINABLE shiftL128 #-} shiftL128 :: Word128 -> Int -> Word128 shiftL128 w@(Word128 a1 a0) s | s == 0 = w- | s < 0 = shiftL128 w (128 - (abs s `mod` 128))+ | s == minBound = zeroWord128+ | s < 0 = shiftR128 w (negate s) | s >= 128 = zeroWord128 | s == 64 = Word128 a0 0 | s > 64 = Word128 (a0 `shiftL` (s - 64)) 0@@ -338,11 +343,12 @@ s0 = a0 `shiftL` s s1 = a1 `shiftL` s + a0 `shiftR` (64 - s) --- Probably not worth inlining this.+{-# INLINABLE shiftR128 #-} shiftR128 :: Word128 -> Int -> Word128 shiftR128 w@(Word128 a1 a0) s- | s < 0 = zeroWord128 | s == 0 = w+ | s == minBound = zeroWord128+ | s < 0 = shiftL128 w (negate s) | s >= 128 = zeroWord128 | s == 64 = Word128 0 a1 | s > 64 = Word128 0 (a1 `shiftR` (s - 64))@@ -352,10 +358,11 @@ s1 = a1 `shiftR` s s0 = a0 `shiftR` s + a1 `shiftL` (64 - s) +{-# INLINABLE rotateL128 #-} rotateL128 :: Word128 -> Int -> Word128 rotateL128 w@(Word128 a1 a0) r | r == 0 = w- | r < 0 = zeroWord128+ | r < 0 = rotateL128 w (128 - (abs r `mod` 128)) | r >= 128 = rotateL128 w (r `mod` 128) | r == 64 = Word128 a0 a1 | r > 64 = rotateL128 (Word128 a0 a1) (r `mod` 64)@@ -365,6 +372,7 @@ s0 = a0 `shiftL` r + a1 `shiftR` (64 - r) s1 = a1 `shiftL` r + a0 `shiftR` (64 - r) +{-# INLINABLE rotateR128 #-} rotateR128 :: Word128 -> Int -> Word128 rotateR128 w@(Word128 a1 a0) r | r == 0 = w@@ -378,6 +386,7 @@ s0 = a0 `shiftR` r + a1 `shiftL` (64 - r) s1 = a1 `shiftR` r + a0 `shiftL` (64 - r) +{-# INLINABLE testBit128 #-} testBit128 :: Word128 -> Int -> Bool testBit128 (Word128 a1 a0) i | i < 0 = False@@ -385,24 +394,28 @@ | i >= 64 = testBit a1 (i - 64) | otherwise = testBit a0 i +{-# INLINABLE bit128 #-} bit128 :: Int -> Word128 bit128 indx | indx < 0 = zeroWord128 | indx >= 128 = zeroWord128 | otherwise = shiftL128 oneWord128 indx +{-# INLINABLE popCount128 #-} popCount128 :: Word128 -> Int popCount128 (Word128 a1 a0) = popCount a1 + popCount a0 -- ----------------------------------------------------------------------------- -- Functions for `FiniteBits` instance. +{-# INLINABLE countLeadingZeros128 #-} countLeadingZeros128 :: Word128 -> Int countLeadingZeros128 (Word128 a1 a0) = case countLeadingZeros a1 of 64 -> 64 + countLeadingZeros a0 res -> res +{-# INLINABLE countTrailingZeros128 #-} countTrailingZeros128 :: Word128 -> Int countTrailingZeros128 (Word128 a1 a0) = case countTrailingZeros a0 of
src/Data/WideWord/Word256.hs view
@@ -393,11 +393,17 @@ complement256 (Word256 a3 a2 a1 a0) = Word256 (complement a3) (complement a2) (complement a1) (complement a0) --- Probably not worth inlining this.+-- Some of the following functions have quite complicated guard clauses, but we make them+-- inlineable anyway so that if the things like the shift amount is a compile time constant+-- most of the function can be dropped leaving only the needed bits inlined.++{-# INLINABLE shiftL256 #-} shiftL256 :: Word256 -> Int -> Word256 shiftL256 w@(Word256 a3 a2 a1 a0) s- | s < 0 || s >= 256 = zeroWord256 | s == 0 = w+ | s == minBound = zeroWord256+ | s < 0 = shiftR256 w (negate s)+ | s >= 256 = zeroWord256 | s > 192 = Word256 (a0 `shiftL` (s - 192)) 0 0 0 | s == 192 = Word256 a0 0 0 0 | s > 128 =@@ -419,10 +425,12 @@ (a1 `shiftL` s + a0 `shiftR` (64 - s)) (a0 `shiftL` s) +{-# INLINABLE shiftR256 #-} shiftR256 :: Word256 -> Int -> Word256 shiftR256 w@(Word256 a3 a2 a1 a0) s- | s < 0 = zeroWord256 | s == 0 = w+ | s == minBound = zeroWord256+ | s < 0 = shiftL256 w (negate s) | s >= 256 = zeroWord256 | s > 192 = Word256 0 0 0 (a3 `shiftR` (s - 192)) | s == 192 = Word256 0 0 0 a3@@ -440,9 +448,10 @@ (a1 `shiftR` s + a2 `shiftL` (64 - s)) (a0 `shiftR` s + a1 `shiftL` (64 - s)) +{-# INLINABLE rotateL256 #-} rotateL256 :: Word256 -> Int -> Word256 rotateL256 w@(Word256 a3 a2 a1 a0) r- | r < 0 = zeroWord256+ | r < 0 = rotateL256 w (256 - (abs r `mod` 256)) | r == 0 = w | r >= 256 = rotateL256 w (r `mod` 256) | r >= 64 = rotateL256 (Word256 a2 a1 a0 a3) (r - 64)@@ -451,6 +460,7 @@ (a3 `shiftL` r + a2 `shiftR` (64 - r)) (a2 `shiftL` r + a1 `shiftR` (64 - r)) (a1 `shiftL` r + a0 `shiftR` (64 - r)) (a0 `shiftL` r + a3 `shiftR` (64 - r)) +{-# INLINABLE rotateR256 #-} rotateR256 :: Word256 -> Int -> Word256 rotateR256 w@(Word256 a3 a2 a1 a0) r | r < 0 = rotateR256 w (256 - (abs r `mod` 256))@@ -462,6 +472,7 @@ (a3 `shiftR` r + a0 `shiftL` (64 - r)) (a2 `shiftR` r + a3 `shiftL` (64 - r)) (a1 `shiftR` r + a2 `shiftL` (64 - r)) (a0 `shiftR` r + a1 `shiftL` (64 - r)) +{-# INLINABLE testBit256 #-} testBit256 :: Word256 -> Int -> Bool testBit256 (Word256 a3 a2 a1 a0) i | i < 0 = False@@ -471,12 +482,14 @@ | i >= 64 = testBit a1 (i - 64) | otherwise = testBit a0 i +{-# INLINABLE bit256 #-} bit256 :: Int -> Word256 bit256 indx | indx < 0 = zeroWord256 | indx >= 256 = zeroWord256 | otherwise = shiftL256 oneWord256 indx +{-# INLINABLE popCount256 #-} popCount256 :: Word256 -> Int popCount256 (Word256 a3 a2 a1 a0) = popCount a3 + popCount a2 + popCount a1 + popCount a0@@ -484,6 +497,7 @@ -- ----------------------------------------------------------------------------- -- Functions for `FiniteBits` instance. +{-# INLINABLE countLeadingZeros256 #-} countLeadingZeros256 :: Word256 -> Int countLeadingZeros256 (Word256 a3 a2 a1 a0) = case countLeadingZeros a3 of@@ -494,6 +508,7 @@ res -> 64 + res res -> res +{-# INLINABLE countTrailingZeros256 #-} countTrailingZeros256 :: Word256 -> Int countTrailingZeros256 (Word256 a3 a2 a1 a0) = case countTrailingZeros a0 of
src/Data/WideWord/Word64.hs view
@@ -151,6 +151,7 @@ !p3 = c3a `plusWord#` c3b `plusWord#` c3c `plusWord#` c3d `plusWord#` c3e +{-# INLINE word64ToHiWord# #-} word64ToHiWord# :: Word64# -> Word# word64ToHiWord# w = word64ToWord# (w `uncheckedShiftRL64#` 32#)
test/Test/Data/WideWord/Int128.hs view
@@ -208,6 +208,13 @@ rot <- H.forAll $ Gen.int (Range.linearFrom 0 (-20000) 20000) toInteger (rotateR (Int128 a1 a0) rot) === correctInt128 (toInteger $ rotateR (Word128 a1 a0) rot) +prop_shift_opposite :: Property+prop_shift_opposite =+ propertyCount $ do+ w128 <- H.forAll genInt128+ rot <- H.forAll $ Gen.int (Range.linearFrom 0 (-150) 150)+ shiftL w128 rot === shiftR w128 (negate rot)+ prop_testBit :: Property prop_testBit = propertyCount $ do
test/Test/Data/WideWord/Word128.hs view
@@ -206,14 +206,12 @@ w128 <- H.forAll genWord128 rot <- H.forAll $ Gen.int (Range.linearFrom 0 (-20000) 20000) let i128 = toInteger128 w128- expected- | rot < 0 = 0- | otherwise =- correctWord128 (i128 `shiftL` erot + i128 `shiftR` (128 - (erot `mod` 128)))- where- erot- | rot < 0 = 128 - (abs rot `mod` 128)- | otherwise = rot `mod` 128+ expected =+ correctWord128 $ i128 `shiftL` erot + i128 `shiftR` (128 - erot)+ where+ erot+ | rot < 0 = 128 - (abs rot `mod` 128)+ | otherwise = rot `mod` 128 toInteger128 (rotateL w128 rot) === expected prop_logical_rotate_right :: Property@@ -229,6 +227,13 @@ | rot < 0 = 128 - (abs rot `mod` 128) | otherwise = rot `mod` 128 toInteger128 (rotateR w128 rot) === expected++prop_shift_opposite :: Property+prop_shift_opposite =+ propertyCount $ do+ w128 <- H.forAll genWord128+ rot <- H.forAll $ Gen.int (Range.linearFrom 0 (-150) 150)+ shiftL w128 rot === shiftR w128 (negate rot) prop_testBit :: Property prop_testBit =
wide-word.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: wide-word-version: 0.1.5.0+version: 0.1.6.0 synopsis: Data types for large but fixed width signed and unsigned integers description: A library to provide data types for large (ie > 64 bits) but fixed width signed@@ -24,8 +24,8 @@ extra-source-files: ChangeLog.md stability: provisional cabal-version: >= 1.10-tested-with: GHC == 8.4.4, GHC == 8.6.5, GHC == 8.8.4, GHC == 8.10.7,- GHC == 9.0.2, GHC == 9.2.1+tested-with: GHC == 8.4.4, GHC == 8.6.5, GHC == 8.8.4, GHC == 8.10.7, GHC == 9.0.2,+ GHC == 9.2.4, GHC == 9.4.7, GHC == 9.6.2, GHC == 9.8.1 library default-language: Haskell2010@@ -41,12 +41,12 @@ other-modules: Data.WideWord.Compat - build-depends: base >= 4.9 && < 4.18+ build-depends: base >= 4.9 && < 4.20 , binary >= 0.8.3.0 && < 0.9- , deepseq >= 1.4.2.0 && < 1.5+ , deepseq >= 1.4.2.0 && < 1.6 -- Required so that GHC.IntWord64 is available on 32 bit systems , ghc-prim- , primitive >= 0.6.4.0 && < 0.8+ , primitive >= 0.6.4.0 && < 0.10 , hashable >= 1.2 && < 1.5 test-suite test@@ -64,9 +64,9 @@ build-depends: base , binary- , bytestring >= 0.10+ , bytestring >= 0.10 && < 0.13 , ghc-prim- , hedgehog >= 1.0 && < 1.3+ , hedgehog >= 1.0 && < 1.5 , primitive , wide-word