wide-word 0.1.7.1 → 0.1.8.0
raw patch · 15 files changed
+531/−65 lines, 15 filesdep −bytestringdep −ghc-primdep ~QuickCheckdep ~basedep ~binary
Dependencies removed: bytestring, ghc-prim
Dependency ranges changed: QuickCheck, base, binary, primitive
Files
- ChangeLog.md +5/−0
- src/Data/WideWord/Compat.hs +1/−1
- src/Data/WideWord/Int128.hs +1/−3
- src/Data/WideWord/Word128.hs +1/−3
- src/Data/WideWord/Word256.hs +22/−26
- src/Data/WideWord/Word64.hs +7/−2
- test/Test/Data/WideWord/Gen.hs +4/−0
- test/Test/Data/WideWord/Word128.hs +2/−0
- test/Test/Data/WideWord/Word256.hs +386/−0
- test/Test/Data/WideWord/Word64.hs +13/−0
- test/test.hs +0/−20
- test/test128.hs +18/−0
- test/test256.hs +16/−0
- test/test64.hs +16/−0
- wide-word.cabal +39/−10
ChangeLog.md view
@@ -1,5 +1,10 @@ # Revision history for wide-word +## 0.1.8.0 -- 2025-09-08++* Fix bug in Word256 implementions (minus).+* Add property tests for Word256.+ ## 0.1.7.1 -- 2025-06-19 * Publish a new version removing an `if` conditional from the cabal
src/Data/WideWord/Compat.hs view
@@ -28,7 +28,7 @@ #if MIN_VERSION_base(4,17,0) import qualified GHC.Base-import GHC.Prim (Word64#, wordToWord64#, word64ToWord#, Int64#)+import GHC.Exts (Word64#, wordToWord64#, word64ToWord#, Int64#) #else import GHC.Base (Int#, Word#, quotRemWord2#, int2Word#, subWordC#, plusWord2#, or#, minusWord#, timesWord2#, word2Int#, xor#, and#, not#, plusWord#, timesWord#)
src/Data/WideWord/Int128.hs view
@@ -1,6 +1,5 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE MultiParamTypeClasses #-}@@ -33,7 +32,6 @@ import Control.DeepSeq (NFData (..)) import Data.Bits (Bits (..), FiniteBits (..), shiftL)-import Data.Data (Data, Typeable) import Data.Ix (Ix) #if ! MIN_VERSION_base(4,11,0) import Data.Semigroup ((<>))@@ -70,7 +68,7 @@ { int128Hi64 :: !Word64 , int128Lo64 :: !Word64 }- deriving (Eq, Data, Generic, Ix, Typeable)+ deriving (Eq, Generic, Ix) instance Hashable Int128 where hashWithSalt s (Int128 a1 a2) = s `hashWithSalt` a1 `hashWithSalt` a2
src/Data/WideWord/Word128.hs view
@@ -1,6 +1,5 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE StrictData #-}@@ -34,7 +33,6 @@ import Control.DeepSeq (NFData (..)) import Data.Bits (Bits (..), FiniteBits (..), shiftL)-import Data.Data (Data, Typeable) import Data.Ix (Ix) #if ! MIN_VERSION_base(4,11,0) import Data.Semigroup ((<>))@@ -62,7 +60,7 @@ { word128Hi64 :: !Word64 , word128Lo64 :: !Word64 }- deriving (Eq, Data, Generic, Ix, Typeable)+ deriving (Eq, Generic, Ix) instance Hashable Word128 where hashWithSalt s (Word128 a1 a2) = s `hashWithSalt` a1 `hashWithSalt` a2
src/Data/WideWord/Word256.hs view
@@ -1,6 +1,5 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE StrictData #-}@@ -31,7 +30,6 @@ import Control.DeepSeq (NFData (..)) import Data.Bits (Bits (..), FiniteBits (..), shiftL)-import Data.Data (Data, Typeable) import Data.Ix (Ix) #if ! MIN_VERSION_base(4,11,0) import Data.Semigroup ((<>))@@ -63,7 +61,7 @@ , word256m0 :: !Word64 , word256lo :: !Word64 }- deriving (Eq, Data, Generic, Ix, Typeable)+ deriving (Eq, Generic, Ix) instance Hashable Word256 where hashWithSalt s (Word256 a1 a2 a3 a4) =@@ -299,25 +297,16 @@ {-# INLINABLE minus256 #-} minus256 :: Word256 -> Word256 -> Word256 minus256 (Word256 a3 a2 a1 a0) (Word256 b3 b2 b1 b0) =- Word256 s3 s2 s1 s0+ Word256 d3 d2 d1 d0 where- !(v1, s0) = subCarryDiff a0 b0- !(v2, s1) =- if v1 == 0- then subCarryDiff a1 b1- else if a1 == 0- then (0xFFFFFFFFFFFFFFFF - b1, 1)- else subCarryDiff (a1 - 1) b1- !(v3, s2) =- if v2 == 0- then subCarryDiff a2 b2- else if a1 == 0- then (0xFFFFFFFFFFFFFFFF - b2, 1)- else subCarryDiff (a2 - 1) b2- !s3 =- if v3 == 0- then a3 - b3- else (a3 - 1) - b3+ !(c1, d0) = subCarryDiff a0 b0+ !(c2a, b1a) = plusCarrySum b1 c1+ !(c2b, d1) = subCarryDiff a1 b1a+ !c2 = c2a + c2b+ !(c3a, b2a) = plusCarrySum b2 c2+ !(c3b, d2) = subCarryDiff a2 b2a+ !c3 = c3a + c3b+ !d3 = a3 - b3 - c3 times256 :: Word256 -> Word256 -> Word256 times256 (Word256 a3 a2 a1 a0) (Word256 b3 b2 b1 b0) =@@ -443,7 +432,8 @@ (a1 `shiftR` (s - 64) + a2 `shiftL` (128 - s)) | s == 64 = Word256 0 a3 a2 a1 | otherwise =- Word256 (a3 `shiftR` s)+ Word256+ (a3 `shiftR` s) (a2 `shiftR` s + a3 `shiftL` (64 - s)) (a1 `shiftR` s + a2 `shiftL` (64 - s)) (a0 `shiftR` s + a1 `shiftL` (64 - s))@@ -451,21 +441,27 @@ {-# INLINABLE rotateL256 #-} rotateL256 :: Word256 -> Int -> Word256 rotateL256 w@(Word256 a3 a2 a1 a0) r- | r < 0 = rotateL256 w (256 - (abs r `mod` 256))+ | r < 0 = rotateR256 w ((abs r) `mod` 256) | r == 0 = w | r >= 256 = rotateL256 w (r `mod` 256)+ | r >= 192 = rotateL256 (Word256 a0 a3 a2 a1) (r - 192)+ | r >= 128 = rotateL256 (Word256 a1 a0 a3 a2) (r - 128) | r >= 64 = rotateL256 (Word256 a2 a1 a0 a3) (r - 64) | otherwise = Word256- (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))+ (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))+ | r < 0 = rotateL256 w ((abs r) `mod` 256) | r == 0 = w | r >= 256 = rotateR256 w (r `mod` 256)+ | r >= 192 = rotateR256 (Word256 a2 a1 a0 a3) (r - 192)+ | r >= 128 = rotateR256 (Word256 a1 a0 a3 a2) (r - 128) | r >= 64 = rotateR256 (Word256 a0 a3 a2 a1) (r - 64) | otherwise = Word256
src/Data/WideWord/Word64.hs view
@@ -28,6 +28,7 @@ module Data.WideWord.Word64 ( mkWord64+ , oneWord64 , plusCarrySum , quotRem2Word64 , showHexWord64@@ -66,6 +67,10 @@ word64Lo32 :: Word64 -> Word32 word64Lo32 = fromIntegral +{-# INLINE oneWord64 #-}+oneWord64 :: Word64+oneWord64 = 1+ {-# INLINE zeroWord64 #-} zeroWord64 :: Word64 zeroWord64 = 0@@ -86,8 +91,8 @@ {-# INLINE subCarryDiff #-} subCarryDiff :: Word64 -> Word64 -> (Word64, Word64) subCarryDiff (W64# a) (W64# b) =- let !(# s, c #) = subWordC# a b- in (W64# (int2Word# c), W64# s)+ let !(# d, c #) = subWordC# a b+ in (W64# (int2Word# c), W64# d) {-# INLINE timesCarryProd #-} timesCarryProd :: Word64 -> Word64 -> (Word64, Word64)
test/Test/Data/WideWord/Gen.hs view
@@ -12,6 +12,10 @@ genInt128 = Int128 <$> genBiasedWord64 <*> genBiasedWord64 +genWord256 :: Gen Word256+genWord256 =+ Word256 <$> genBiasedWord64 <*> genBiasedWord64 <*> genBiasedWord64 <*> genBiasedWord64+ genWord32 :: Gen Word32 genWord32 = Gen.word32 Range.constantBounded
test/Test/Data/WideWord/Word128.hs view
@@ -241,6 +241,8 @@ | idx >= 128 = 0 | otherwise = bit idx toInteger128 (bit idx :: Word128) === expected+ unless (expected == 0) $+ toInteger128 ((bit idx :: Word128) - 1) === expected - 1 prop_popCount :: Property prop_popCount =
+ test/Test/Data/WideWord/Word256.hs view
@@ -0,0 +1,386 @@+{-# LANGUAGE TemplateHaskell #-}+module Test.Data.WideWord.Word256+ ( tests+ ) where++import Control.Monad.IO.Class (liftIO)+import Control.Monad (unless)++import qualified Data.Binary as Binary+import Data.Bits ((.&.), (.|.), bit, complement, countLeadingZeros, countTrailingZeros+ , popCount, rotateL, rotateR, shiftL, shiftR, testBit, xor)+import Data.Primitive.PrimArray+import Data.Primitive.Ptr+import Data.Word (Word64, Word8)+import Data.WideWord++import Foreign (allocaBytes)+import Foreign.Storable (Storable (..))++import Hedgehog (Property, (===), discover)+import qualified Hedgehog as H+import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range++import Test.Data.WideWord.Gen+++-- Set the number of times to run each property test here.+propertyCount :: H.PropertyT IO () -> Property+propertyCount =+ H.withTests 10000 . H.property++prop_constructor_and_accessors :: Property+prop_constructor_and_accessors =+ propertyCount $ do+ (hi, m1, m0, lo) <- H.forAll $ (,,,) <$> genWord64 <*> genWord64 <*> genWord64 <*> genWord64+ let w256 = Word256 hi m1 m0 lo+ (word256hi w256, word256m1 w256, word256m0 w256, word256lo w256) === (hi, m1, m0, lo)++{-+prop_byte_swap :: Property+prop_byte_swap =+ propertyCount $ do+ h <- H.forAll genWor256+ l <- H.forAll $ Gen.filter (/= h) genWord256+ let w256 = Word256 (word256Hi64 h) (word256Lo64 h) (word256Hi64 l) (word256Lo64 l)+ swapped = byteSwapWord256 w256+ (byteSwapWord256 swapped)+ === (w256)+-}+++prop_derivied_eq_instance :: Property+prop_derivied_eq_instance =+ propertyCount $ do+ (a3, a2, a1, a0) <- H.forAll $ (,,,) <$> genWord64 <*> genWord64 <*> genWord64 <*> genWord64+ (b3, b2, b1, b0) <- H.forAll $ (,,,) <$> genWord64 <*> genWord64 <*> genWord64 <*> genWord64+ (Word256 a3 a2 a1 a0 == Word256 b3 b2 b1 b0) === (a3 == b3 && a2 == b2 && a1 == b1 && a0 == b0)++prop_ord_instance :: Property+prop_ord_instance =+ propertyCount $ do+ (a, b) <- H.forAll $ (,) <$> genWord256 <*> genWord256+ compare a b === compare (toInteger256 a) (toInteger256 b)++prop_show_instance :: Property+prop_show_instance =+ propertyCount $ do+ w256 <- H.forAll genWord256+ show w256 === show (toInteger256 w256)++prop_read_instance :: Property+prop_read_instance =+ propertyCount $ do+ (a3, a2, a1, a0) <- H.forAll $ (,,,) <$> genWord64 <*> genWord64 <*> genWord64 <*> genWord64+ read (show $ Word256 a3 a2 a1 a0) === Word256 a3 a2 a1 a0++prop_read_show :: Property+prop_read_show =+ propertyCount $ do+ (a3, a2, a1, a0) <- H.forAll $ (,,,) <$> genWord64 <*> genWord64 <*> genWord64 <*> genWord64+ H.tripping (Word256 a3 a2 a1 a0) show (Just . read)++prop_succ :: Property+prop_succ =+ propertyCount $ do+ w256 <- H.forAll $ Gen.filter (< maxBound) genWord256+ toInteger256 (succ w256) === succ (toInteger256 w256)++prop_pred :: Property+prop_pred =+ propertyCount $ do+ w256 <- H.forAll $ Gen.filter (> 0) genWord256+ toInteger256 (pred w256) === pred (toInteger256 w256)++prop_toEnum_fromEnum :: Property+prop_toEnum_fromEnum =+ propertyCount $ do+ a0 <- H.forAll genWord32+ let w256 = Word256 0 0 0 (fromIntegral a0)+ e256 = fromEnum w256+ toInteger e256 === toInteger a0+ toInteger256 (toEnum e256 :: Word256) === toInteger a0++prop_addition :: Property+prop_addition =+ propertyCount $ do+ (a, b) <- H.forAll $ (,) <$> genWord256 <*> genWord256+ toInteger256 (a + b) === correctWord256 (toInteger256 a + toInteger256 b)++prop_subtraction :: Property+prop_subtraction =+ propertyCount $ do+ (a, b) <- H.forAll $ (,) <$> genWord256 <*> genWord256+ let ai = toInteger256 a+ bi = toInteger256 b+ expected = ai + (1 `shiftL` 256) - bi+ toInteger256 (a - b) === correctWord256 expected+++prop_multiplication :: Property+prop_multiplication =+ propertyCount $ do+ (a, b) <- H.forAll $ (,) <$> genWord256 <*> genWord256+ toInteger256 (a * b) === correctWord256 (toInteger256 a * toInteger256 b)++prop_negate :: Property+prop_negate =+ propertyCount $ do+ w256 <- H.forAll genWord256+ toInteger256 (negate w256) === correctWord256 (negate $ toInteger256 w256)++prop_abs :: Property+prop_abs =+ propertyCount $ do+ w256 <- H.forAll genWord256+ toInteger256 (abs w256) === correctWord256 (abs $ toInteger256 w256)++prop_signum :: Property+prop_signum =+ propertyCount $ do+ w256 <- H.forAll genWord256+ toInteger256 (signum w256) === signum (toInteger256 w256)++prop_fromInteger :: Property+prop_fromInteger =+ propertyCount $ do+ (a3, a2, a1, a0) <- H.forAll $ (,,,) <$> genWord64 <*> genWord64 <*> genWord64 <*> genWord64+ let w256 = fromInteger $ mkInteger a3 a2 a1 a0+ (word256hi w256, word256m1 w256, word256m0 w256, word256lo w256) === (a3, a2, a1, a0)++prop_bitwise_and :: Property+prop_bitwise_and =+ propertyCount $ do+ (a, b) <- H.forAll $ (,) <$> genWord256 <*> genWord256+ toInteger256 (a .&. b) === (toInteger256 a .&. toInteger256 b)++prop_bitwise_or :: Property+prop_bitwise_or =+ propertyCount $ do+ (a, b) <- H.forAll $ (,) <$> genWord256 <*> genWord256+ toInteger256 (a .|. b) === (toInteger256 a .|. toInteger256 b)++prop_bitwise_xor :: Property+prop_bitwise_xor =+ propertyCount $ do+ (a, b) <- H.forAll $ (,) <$> genWord256 <*> genWord256+ toInteger256 (xor a b) === xor (toInteger256 a) (toInteger256 b)++prop_complement :: Property+prop_complement =+ propertyCount $ do+ (a3, a2, a1, a0) <- H.forAll $ (,,,) <$> genWord64 <*> genWord64 <*> genWord64 <*> genWord64+ toInteger256 (complement $ Word256 a3 a2 a1 a0) === mkInteger (complement a3) (complement a2) (complement a1) (complement a0)++prop_logical_shift_left :: Property+prop_logical_shift_left =+ propertyCount $ do+ w256 <- H.forAll genWord256+ shift <- H.forAll $ Gen.int (Range.linear 0 260)+ toInteger256 (shiftL w256 shift) === correctWord256 (shiftL (toInteger256 w256) shift)++prop_logical_shift_right :: Property+prop_logical_shift_right =+ propertyCount $ do+ w256 <- H.forAll genWord256+ shift <- H.forAll $ Gen.int (Range.linear 0 260)+ toInteger256 (shiftR w256 shift) === shiftR (toInteger256 w256) shift++prop_logical_rotate_left :: Property+prop_logical_rotate_left =+ propertyCount $ do+ w256 <- H.forAll genWord256+ rot <- H.forAll $ Gen.int (Range.linearFrom 0 (-300) 300)+ let i256 = toInteger256 w256+ expected =+ correctWord256 (i256 `shiftL` erot + i256 `shiftR` (256 - erot))+ where+ erot+ | rot < 0 = 256 - (abs rot `mod` 256)+ | otherwise = rot `mod` 256+ toInteger256 (rotateL w256 rot) === expected++prop_logical_rotate_right :: Property+prop_logical_rotate_right =+ propertyCount $ do+ w256 <- H.forAll genWord256+ rot <- H.forAll $ Gen.int (Range.linearFrom 0 (-300) 300)+ let i256 = toInteger256 w256+ expected =+ correctWord256 $ i256 `shiftR` erot + i256 `shiftL` (256 - erot)+ where+ erot+ | rot < 0 = 256 - (abs rot `mod` 256)+ | otherwise = rot `mod` 256+ toInteger256 (rotateR w256 rot) === expected++prop_shift_opposite :: Property+prop_shift_opposite =+ propertyCount $ do+ w256 <- H.forAll genWord256+ rot <- H.forAll $ Gen.int (Range.linearFrom 0 (-300) 300)+ shiftL w256 rot === shiftR w256 (negate rot)++prop_testBit :: Property+prop_testBit =+ propertyCount $ do+ w256 <- H.forAll genWord256+ idx <- H.forAll $ Gen.int (Range.linearFrom 0 (-200) 200)+ let expected+ | idx < 0 = False+ | idx >= 256 = False+ | otherwise = testBit (toInteger256 w256) idx+ testBit w256 idx === expected+++prop_bit :: Property+prop_bit =+ propertyCount $ do+ b <- H.forAll $ Gen.int (Range.linearFrom 0 (-300) 300)+ let idx = fromIntegral b+ expected+ | idx < 0 = 0+ | idx >= 256 = 0+ | otherwise = bit idx+ toInteger256 (bit idx :: Word256) === expected+++prop_popCount :: Property+prop_popCount =+ propertyCount $ do+ w256 <- H.forAll genWord256+ popCount w256 === popCount (toInteger256 w256)++prop_countLeadingZeros :: Property+prop_countLeadingZeros =+ propertyCount $ do+ (a3, a2, a1, a0) <- H.forAll $ (,,,) <$> genWord64 <*> genWord64 <*> genWord64 <*> genWord64+ let expected =+ case (a3, a2, a1, a0) of+ (0, 0, 0, _) -> 192 + countLeadingZeros a0+ (0, 0, _, _) -> 128 + countLeadingZeros a1+ (0, _, _, _) -> 64 + countLeadingZeros a2+ (_, _, _, _) -> countLeadingZeros a3+ countLeadingZeros (Word256 a3 a2 a1 a0) === expected++prop_countTrailingZeros :: Property+prop_countTrailingZeros =+ propertyCount $ do+ (a3, a2, a1, a0) <- H.forAll $ (,,,) <$> genWord64 <*> genWord64 <*> genWord64 <*> genWord64+ let expected =+ case (a3, a2, a1, a0) of+ (_, 0, 0, 0) -> 192 + countTrailingZeros a3+ (_, _, 0, 0) -> 128 + countTrailingZeros a2+ (_, _, _, 0) -> 64 + countTrailingZeros a1+ (_, _, _, _) -> countTrailingZeros a0+ countTrailingZeros (Word256 a3 a2 a1 a0) === expected++-- Don't need to test `quot` or `rem` because they are implemented by applying+-- `fst` or `snd` to the output of `quotRem`.+prop_quotRem :: Property+prop_quotRem =+ propertyCount $ do+ num <- H.forAll genWord256+ den <- H.forAll $ Gen.filter (/= 0) genWord256+ let (q, r) = quotRem num den+ (toInteger256 q, toInteger256 r) === quotRem (toInteger256 num) (toInteger256 den)++prop_divMod :: Property+prop_divMod =+ propertyCount $ do+ num <- H.forAll genWord256+ den <- H.forAll $ Gen.filter (/= 0) genWord256+ let (d, m) = divMod num den+ (toInteger256 d, toInteger256 m) === divMod (toInteger256 num) (toInteger256 den)++prop_roundtrip_binary :: Property+prop_roundtrip_binary =+ propertyCount $ do+ w256 <- H.forAll genWord256+ H.tripping w256 Binary.encode (Just . Binary.decode)++prop_peek_and_poke :: Property+prop_peek_and_poke =+ propertyCount $ do+ w256 <- H.forAll genWord256+ ar <- liftIO $+ allocaBytes (sizeOf zeroWord256) $ \ ptr -> do+ poke ptr w256+ peek ptr+ toInteger256 ar === toInteger256 w256++prop_peekElemOff_pokeElemOff :: Property+prop_peekElemOff_pokeElemOff =+ propertyCount $ do+ a256 <- H.forAll genWord256+ b256 <- H.forAll genWord256+ (ar, br) <- liftIO $+ allocaBytes (2 * sizeOf zeroWord256) $ \ ptr -> do+ pokeElemOff ptr 0 a256+ pokeElemOff ptr 1 b256+ (,) <$> peekElemOff ptr 0 <*> peekElemOff ptr 1+ (toInteger256 ar, toInteger256 br) === (toInteger256 a256, toInteger256 b256)+++prop_ToFromPrimArray :: Property+prop_ToFromPrimArray =+ H.withTests 2000 . H.property $ do+ as <- H.forAll $+ Gen.list (fromIntegral <$> (Range.linearBounded :: Range.Range Word8)) genWord256+ as === primArrayToList (primArrayFromList as)++prop_WriteReadPrimArray :: Property+prop_WriteReadPrimArray =+ H.withTests 2000 . H.property $ do+ as <- H.forAll $ Gen.list (Range.linear 1 256) genWord256+ unless (null as) $ do+ let len = length as+ arr = primArrayFromList as+ i <- (`mod` len) <$> H.forAll (Gen.int (Range.linear 0 (len - 1)))+ new <- H.forAll genWord256+ props <- liftIO $ do+ marr <- unsafeThawPrimArray arr+ prev <- readPrimArray marr i+ let prevProp = prev === (as !! i)+ writePrimArray marr i new+ cur <- readPrimArray marr i+ setPrimArray marr i 1 prev+ arr' <- unsafeFreezePrimArray marr+ return [prevProp, cur === new, arr === arr']+ sequence_ props++prop_readOffPtr_writeOffPtr :: Property+prop_readOffPtr_writeOffPtr =+ propertyCount $ do+ a256 <- H.forAll genWord256+ b256 <- H.forAll genWord256+ (ar, br) <- liftIO $+ allocaBytes (2 * sizeOf zeroWord256) $ \ ptr -> do+ writeOffPtr ptr 0 a256+ writeOffPtr ptr 1 b256+ (,) <$> readOffPtr ptr 0 <*> readOffPtr ptr 1+ (ar, br) === (a256, b256)++-- -----------------------------------------------------------------------------++mkInteger :: Word64 -> Word64 -> Word64 -> Word64 -> Integer+mkInteger a3 a2 a1 a0 =+ fromIntegral a3 `shiftL` 192 + fromIntegral a2 `shiftL` 128+ + fromIntegral a1 `shiftL` 64 + fromIntegral a0++correctWord256 :: Integer -> Integer+correctWord256 i+ | i >= 0 && i <= maxWord256 = i+ | otherwise = i .&. maxWord256+ where+ maxWord256 = (1 `shiftL` 256) - 1++toInteger256 :: Word256 -> Integer+toInteger256 = toInteger++-- -----------------------------------------------------------------------------++tests :: IO Bool+tests =+ H.checkParallel $$discover
test/Test/Data/WideWord/Word64.hs view
@@ -226,6 +226,7 @@ -- Actually testing the default compiler/machine implementation so range must be valid. idx <- H.forAll $ Gen.int (Range.linear 0 63) toInteger64 (bit idx :: Word64) === (bit idx :: Integer)+ toInteger64 ((bit idx :: Word64) - 1) === ((bit idx - 1) :: Integer) prop_popCount :: Property prop_popCount =@@ -376,6 +377,18 @@ if a >= b then (carry, toInteger64 d) === (0, toInteger64 a - toInteger64 b) else (carry, toInteger64 d) === (1, 1 + fromIntegral (maxBound :: Word64) - toInteger64 b + toInteger64 a)++prop_subDiffCarry_ok :: Property+prop_subDiffCarry_ok =+ propertyCount $ do+ a <- H.forAll genBiasedWord64+ b <- H.forAll genBiasedWord64+ let (actualC, actualD) = subCarryDiff a b+ let (expectedC, expectedD) =+ if (a >= b)+ then (zeroWord64, a - b)+ else (oneWord64, a + maxBound + 1 - b)+ (actualC, actualD) === (expectedC, expectedD) -- -----------------------------------------------------------------------------
− test/test.hs
@@ -1,20 +0,0 @@-import Control.Monad (unless)--import System.Exit (exitFailure)--import qualified Test.Data.WideWord.Int128-import qualified Test.Data.WideWord.Word64-import qualified Test.Data.WideWord.Word128--main :: IO ()-main = runTests- [ Test.Data.WideWord.Int128.tests- , Test.Data.WideWord.Word64.tests- , Test.Data.WideWord.Word128.tests- ]--runTests :: [IO Bool] -> IO ()-runTests tests = do- result <- and <$> sequence tests- unless result- exitFailure
+ test/test128.hs view
@@ -0,0 +1,18 @@+import Control.Monad (unless)++import System.Exit (exitFailure)++import qualified Test.Data.WideWord.Int128+import qualified Test.Data.WideWord.Word128++main :: IO ()+main = runTests+ [ Test.Data.WideWord.Int128.tests+ , Test.Data.WideWord.Word128.tests+ ]++runTests :: [IO Bool] -> IO ()+runTests tests = do+ result <- and <$> sequence tests+ unless result+ exitFailure
+ test/test256.hs view
@@ -0,0 +1,16 @@+import Control.Monad (unless)++import System.Exit (exitFailure)++import qualified Test.Data.WideWord.Word256++main :: IO ()+main = runTests+ [ Test.Data.WideWord.Word256.tests+ ]++runTests :: [IO Bool] -> IO ()+runTests tests = do+ result <- and <$> sequence tests+ unless result+ exitFailure
+ test/test64.hs view
@@ -0,0 +1,16 @@+import Control.Monad (unless)++import System.Exit (exitFailure)++import qualified Test.Data.WideWord.Word64++main :: IO ()+main = runTests+ [ Test.Data.WideWord.Word64.tests+ ]++runTests :: [IO Bool] -> IO ()+runTests tests = do+ result <- and <$> sequence tests+ unless result+ exitFailure
wide-word.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: wide-word-version: 0.1.7.1+version: 0.1.8.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@@ -42,35 +42,64 @@ other-modules: Data.WideWord.Compat - build-depends: base >= 4.9 && < 4.22+ build-depends: base >= 4.9 && < 4.23 , binary >= 0.8.3.0 && < 0.9 , 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.10 , hashable >= 1.2 && < 1.6 -test-suite test+test-suite test256 default-language: Haskell2010 ghc-options: -Wall -fwarn-tabs -threaded -O2 type: exitcode-stdio-1.0 - main-is: test.hs+ main-is: test256.hs hs-source-dirs: test other-modules: Test.Data.WideWord.Gen+ Test.Data.WideWord.Word256++ build-depends: base+ , binary+ , hedgehog >= 1.0 && < 1.6+ , primitive+ , wide-word++test-suite test128+ default-language: Haskell2010+ ghc-options: -Wall -fwarn-tabs -threaded -O2+ type: exitcode-stdio-1.0++ main-is: test128.hs+ hs-source-dirs: test++ other-modules: Test.Data.WideWord.Gen Test.Data.WideWord.Int128- Test.Data.WideWord.Word64 Test.Data.WideWord.Word128 build-depends: base , binary- , bytestring >= 0.10- , ghc-prim , hedgehog >= 1.0 && < 1.6 , primitive , wide-word +test-suite test64+ default-language: Haskell2010+ ghc-options: -Wall -fwarn-tabs -threaded -O2+ type: exitcode-stdio-1.0++ main-is: test64.hs+ hs-source-dirs: test++ other-modules: Test.Data.WideWord.Gen+ Test.Data.WideWord.Word64++ build-depends: base+ , binary+ , hedgehog >= 1.0 && < 1.6+ , primitive+ , wide-word+ test-suite laws default-language: Haskell2010 ghc-options: -Wall@@ -80,7 +109,7 @@ hs-source-dirs: test build-depends: base- , QuickCheck >= 2.9.2 && < 2.16+ , QuickCheck >= 2.9.2 && < 2.17 , quickcheck-classes >= 0.6.3 && < 0.7.0 , primitive , semirings >= 0.2 && < 0.8