wide-word 0.1.6.0 → 0.1.9.0
raw patch · 20 files changed
Files
- ChangeLog.md +25/−0
- src/Data/WideWord.hs +1/−0
- src/Data/WideWord/Compat.hs +1/−1
- src/Data/WideWord/Int128.hs +12/−4
- src/Data/WideWord/Int256.hs +700/−0
- src/Data/WideWord/Word128.hs +3/−3
- src/Data/WideWord/Word256.hs +26/−26
- src/Data/WideWord/Word64.hs +31/−43
- test/Test/Data/WideWord/Gen.hs +8/−0
- test/Test/Data/WideWord/Int128.hs +4/−10
- test/Test/Data/WideWord/Int256.hs +370/−0
- test/Test/Data/WideWord/Word128.hs +6/−22
- test/Test/Data/WideWord/Word256.hs +389/−0
- test/Test/Data/WideWord/Word64.hs +14/−1
- test/laws.hs +31/−0
- test/test.hs +0/−20
- test/test128.hs +18/−0
- test/test256.hs +18/−0
- test/test64.hs +16/−0
- wide-word.cabal +45/−13
ChangeLog.md view
@@ -1,5 +1,30 @@ # Revision history for wide-word +## 0.1.9.0 -- 2026-01-21++* Add Int256 type contributed by Dmitry Kovalev.+* Fixed 32 bit support and CI from Bodgrim.+* Fix inclusion of MachDeps.h C header file from Bodgrim.++## 0.1.8.1 -- 2025-09-13++* Reintroduce Data instances that were incorrectly removed in 0.1.8.0.++## 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+ file.+* Update `tested-with` versions in cabal file.++## 0.1.7.0 -- 2025-03-07++* Improvements to compare128 for Int128.+ ## 0.1.6.0 -- 2023-10-24 * Fixes for shifting/rotating by negative values.
src/Data/WideWord.hs view
@@ -3,6 +3,7 @@ ) where import Data.WideWord.Int128 as X+import Data.WideWord.Int256 as X import Data.WideWord.Word64 as X import Data.WideWord.Word128 as X import Data.WideWord.Word256 as X
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
@@ -3,7 +3,6 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE MagicHash #-}-{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE StrictData #-} {-# LANGUAGE UnboxedTuples #-} {-# OPTIONS_GHC -funbox-strict-fields #-}@@ -23,6 +22,8 @@ ---- "modulo 2^128" result as one would expect from a fixed width unsigned word. ------------------------------------------------------------------------------- +#include <MachDeps.h>+ module Data.WideWord.Int128 ( Int128 (..) , byteSwapInt128@@ -70,7 +71,7 @@ { int128Hi64 :: !Word64 , int128Lo64 :: !Word64 }- deriving (Eq, Data, Generic, Ix, Typeable)+ deriving (Eq, Data, Generic, Ix) instance Hashable Int128 where hashWithSalt s (Int128 a1 a2) = s `hashWithSalt` a1 `hashWithSalt` a2@@ -234,7 +235,14 @@ -- Functions for `Ord` instance. compare128 :: Int128 -> Int128 -> Ordering-compare128 a b = compare (toInteger128 a) (toInteger128 b)+compare128 (Int128 a1 a0) (Int128 b1 b0)+ | aIsNeg == bIsNeg = compare a1 b1 <> compare a0 b0+ | bIsNeg = GT+ | otherwise = LT+ where+ aIsNeg = isNeg a1+ bIsNeg = isNeg b1+ isNeg = (>= 0x8000000000000000) -- ----------------------------------------------------------------------------- -- Functions for `Enum` instance.@@ -585,7 +593,7 @@ unInt (I# i#) = i# index0, index1 :: Int-#if WORDS_BIGENDIAN+#ifdef WORDS_BIGENDIAN index0 = 1 index1 = 0 #else
+ src/Data/WideWord/Int256.hs view
@@ -0,0 +1,700 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE StrictData #-}+{-# LANGUAGE UnboxedTuples #-}+{-# OPTIONS_GHC -funbox-strict-fields #-}++#include <MachDeps.h>++module Data.WideWord.Int256+ ( Int256 (..)+ , byteSwapInt256+ , showHexInt256+ , zeroInt256+ ) where++import Control.DeepSeq (NFData (..))++import Data.Bits (Bits (..), FiniteBits (..), shiftL)+import Data.Data (Data)+import Data.Ix (Ix)+#if ! MIN_VERSION_base(4,11,0)+import Data.Semigroup ((<>))+#endif+++import Numeric++import Foreign.Ptr (Ptr, castPtr)+import Foreign.Storable (Storable (..))++import GHC.Base (Int (..))+import GHC.Enum (predError, succError)+import GHC.Exts ((*#), (+#), Int#, State#, Addr#, ByteArray#, MutableByteArray#)+import GHC.Generics+import GHC.Real ((%))+import GHC.Word (Word32, Word64, byteSwap64)++import Data.Primitive.Types (Prim (..), defaultSetByteArray#, defaultSetOffAddr#)++import Data.Hashable (Hashable, hashWithSalt)+import Data.Binary (Binary (get, put))++import Data.WideWord.Word64+++data Int256 = Int256+ { int256hi :: !Word64+ , int256m1 :: !Word64+ , int256m0 :: !Word64+ , int256lo :: !Word64+ }+ deriving (Eq, Data, Generic, Ix)++instance Hashable Int256 where+ hashWithSalt s (Int256 a1 a2 a3 a4) =+ s `hashWithSalt` a1 `hashWithSalt` a2 `hashWithSalt` a3 `hashWithSalt` a4++-- | @since 0.1.5.0+instance Binary Int256 where+ put (Int256 a1 a2 a3 a4) = put a1 >> put a2 >> put a3 >> put a4+ get = Int256 <$> get <*> get <*> get <*> get++byteSwapInt256 :: Int256 -> Int256+byteSwapInt256 (Int256 a3 a2 a1 a0) = Int256 (byteSwap64 a0) (byteSwap64 a1) (byteSwap64 a2) (byteSwap64 a3)++showHexInt256 :: Int256 -> String+showHexInt256 (Int256 a3 a2 a1 a0)+ | a3 == 0 =+ if a2 == 0+ then if a1 == 0+ then showHex a0 ""+ else showHex a1 zeros0 ++ showHex a0 ""+ else showHex a2 zeros1 ++ showHex a1 zeros0 ++ showHex a0 ""+ | otherwise =+ showHex a3 zeros2 ++ showHex a2 zeros1+ ++ showHex a1 zeros0 ++ showHex a0 ""+ where+ h0 = showHex a0 ""+ h1 = showHex a1 ""+ h2 = showHex a2 ""+ zeros0 = replicate (16 - length h0) '0'+ zeros1 = replicate (16 - length h1) '0'+ zeros2 = replicate (16 - length h2) '0'++instance Show Int256 where+ show = show . toInteger++instance Read Int256 where+ readsPrec p s = [(fromInteger256 (x :: Integer), r) | (x, r) <- readsPrec p s]++instance Ord Int256 where+ compare = compare256++instance Bounded Int256 where+ minBound = Int256 0x8000000000000000 0 0 0+ maxBound = Int256 0x7fffffffffffffff maxBound maxBound maxBound++instance Enum Int256 where+ succ = succ256+ pred = pred256+ toEnum = toEnum256+ fromEnum = fromEnum256++instance Num Int256 where+ (+) = plus256+ (-) = minus256+ (*) = times256+ negate = negate256+ abs = abs256+ signum = signum256+ fromInteger = fromInteger256++instance Bits Int256 where+ (.&.) = and256+ (.|.) = or256+ xor = xor256+ complement = complement256+ shiftL = shiftL256+ unsafeShiftL = shiftL256+ shiftR = shiftR256+ unsafeShiftR = shiftR256+ rotateL = rotateL256+ rotateR = rotateR256++ bitSize _ = 256+ bitSizeMaybe _ = Just 256+ isSigned _ = True++ testBit = testBit256+ bit = bit256++ popCount = popCount256++instance FiniteBits Int256 where+ finiteBitSize _ = 256+ countLeadingZeros = countLeadingZeros256+ countTrailingZeros = countTrailingZeros256++instance Real Int256 where+ toRational x = toInteger256 x % 1++instance Integral Int256 where+ quot n d = fst (quotRem256 n d)+ rem n d = snd (quotRem256 n d)+ div n d = fst (divMod256 n d)+ mod n d = snd (divMod256 n d)+ quotRem = quotRem256+ divMod = divMod256+ toInteger = toInteger256+++instance Storable Int256 where+ sizeOf i = I# (sizeOf256# i)+ alignment i = I# (alignment256# i)+ peek = peek256+ peekElemOff = peekElemOff256+ poke = poke256+ pokeElemOff = pokeElemOff256++instance NFData Int256 where+ -- The fields are already strict and unpacked, so do nothing.+ rnf !_ = ()++instance Prim Int256 where+ sizeOf# = sizeOf256#+ alignment# = alignment256#+ indexByteArray# = indexByteArray256#+ readByteArray# = readByteArray256#+ writeByteArray# = writeByteArray256#+ setByteArray# = setByteArray256#+ indexOffAddr# = indexOffAddr256#+ readOffAddr# = readOffAddr256#+ writeOffAddr# = writeOffAddr256#+ setOffAddr# = setOffAddr256#+ {-# INLINE sizeOf# #-}+ {-# INLINE alignment# #-}+ {-# INLINE indexByteArray# #-}+ {-# INLINE readByteArray# #-}+ {-# INLINE writeByteArray# #-}+ {-# INLINE setByteArray# #-}+ {-# INLINE indexOffAddr# #-}+ {-# INLINE readOffAddr# #-}+ {-# INLINE writeOffAddr# #-}+ {-# INLINE setOffAddr# #-}++-- -----------------------------------------------------------------------------+-- Rewrite rules.++{-# RULES+"fromIntegral :: Int -> Int256" fromIntegral = fromInt+"fromIntegral :: Word -> Int256" fromIntegral = fromWord+"fromIntegral :: Word32 -> Int256" fromIntegral = fromWord32+"fromIntegral :: Word64 -> Int256" fromIntegral = Int256 0 0 0++"fromIntegral :: Int256 -> Int" fromIntegral = toInt+"fromIntegral :: Int256 -> Word" fromIntegral = toWord+"fromIntegral :: Int256 -> Word32" fromIntegral = toWord32+"fromIntegral :: Int256 -> Word64" fromIntegral = \(Int256 _ _ _ w) -> w+ #-}++{-# INLINE fromInt #-}+fromInt :: Int -> Int256+fromInt = Int256 0 0 0 . fromIntegral++{-# INLINE fromWord #-}+fromWord :: Word -> Int256+fromWord = Int256 0 0 0 . fromIntegral++{-# INLINE fromWord32 #-}+fromWord32 :: Word32 -> Int256+fromWord32 = Int256 0 0 0 . fromIntegral++{-# INLINE toInt #-}+toInt :: Int256 -> Int+toInt (Int256 _ _ _ w) = fromIntegral w++{-# INLINE toWord #-}+toWord :: Int256 -> Word+toWord (Int256 _ _ _ w) = fromIntegral w++{-# INLINE toWord32 #-}+toWord32 :: Int256 -> Word32+toWord32 (Int256 _ _ _ w) = fromIntegral w++-- -----------------------------------------------------------------------------+-- Functions for `Ord` instance.++compare256 :: Int256 -> Int256 -> Ordering+compare256 (Int256 a3 a2 a1 a0) (Int256 b3 b2 b1 b0)+ | aIsNeg == bIsNeg = compare a3 b3 <> compare a2 b2 <> compare a1 b1 <> compare a0 b0+ | bIsNeg = GT+ | otherwise = LT+ where+ aIsNeg = isNeg a3+ bIsNeg = isNeg b3+ isNeg = (>= 0x8000000000000000)++-- -----------------------------------------------------------------------------+-- Functions for `Enum` instance.++succ256 :: Int256 -> Int256+succ256 (Int256 a3 a2 a1 a0)+ | a0 == maxBound =+ if a1 == maxBound+ then if a2 == maxBound+ then if a3 == 0x7fffffffffffffff+ then succError "Int256"+ else Int256 (a3 + 1) 0 0 0+ else Int256 a3 (a2 + 1) 0 0+ else Int256 a3 a2 (a1 + 1) 0+ | otherwise = Int256 a3 a2 a1 (a0 + 1)+++pred256 :: Int256 -> Int256+pred256 (Int256 a3 a2 a1 a0)+ | a0 == 0 =+ if a1 == 0+ then if a2 == 0+ then if a3 == 0x8000000000000000+ then predError "Int256"+ else Int256 (a3 - 1) maxBound maxBound maxBound+ else Int256 a3 (a2 - 1) maxBound maxBound+ else Int256 a3 a2 (a1 - 1) maxBound+ | otherwise = Int256 a3 a2 a1 (a0 - 1)++++{-# INLINABLE toEnum256 #-}+toEnum256 :: Int -> Int256+toEnum256 i = Int256 0 0 0 (toEnum i)++{-# INLINABLE fromEnum256 #-}+fromEnum256 :: Int256 -> Int+fromEnum256 (Int256 _ _ _ a0) = fromEnum a0++-- -----------------------------------------------------------------------------+-- Functions for `Num` instance.++{-# INLINABLE plus256 #-}+plus256 :: Int256 -> Int256 -> Int256+plus256 (Int256 a3 a2 a1 a0) (Int256 b3 b2 b1 b0) =+ Int256 s3 s2 s1 s0+ where+ !(c1, s0) = plusCarrySum a0 b0+ !(c2a, s1a) = plusCarrySum a1 b1+ !(c2b, s1) = plusCarrySum s1a c1+ !c2 = c2a + c2b+ !(c3a, s2a) = plusCarrySum a2 b2+ !(c3b, s2) = plusCarrySum s2a c2+ !c3 = c3a + c3b+ !s3 = a3 + b3 + c3++{-# INLINABLE minus256 #-}+minus256 :: Int256 -> Int256 -> Int256+minus256 (Int256 a3 a2 a1 a0) (Int256 b3 b2 b1 b0) =+ Int256 d3 d2 d1 d0+ where+ !(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 :: Int256 -> Int256 -> Int256+times256 (Int256 a3 a2 a1 a0) (Int256 b3 b2 b1 b0) =+ Int256 r3 r2 r1 r0+ where+ !(c00, p00) = timesCarryProd a0 b0+ !(c01, p01) = timesCarryProd a0 b1+ !(c02, p02) = timesCarryProd a0 b2+ !p03 = a0 * b3+ !(c10, p10) = timesCarryProd a1 b0+ !(c11, p11) = timesCarryProd a1 b1+ !p12 = a1 * b2+ !(c20, p20) = timesCarryProd a2 b0+ !p21 = a2 * b1+ !p30 = a3 * b0+ !r0 = p00+ !c1 = c00+ !(c2x, r1a) = plusCarrySum p01 p10+ !(c2y, r1b) = plusCarrySum r1a c1+ !(c3w, c2) = plusCarrySum c2x c2y+ !r1 = r1b+ !(c3x, r2a) = plusCarrySum p11 p20+ !(c3y, r2b) = plusCarrySum p02 r2a+ !(c3z, r2c) = plusCarrySum r2b c2+ !(c3s, r2d) = plusCarrySum r2c c01+ !(c3t, r2e) = plusCarrySum r2d c10+ !r2 = r2e+ !r3 = p30 + p21 + p12 + p03 + c3w + c3x ++ c3y + c3z + c3s + c3t + c02 + c11 + c20++{-# INLINABLE negate256 #-}+negate256 :: Int256 -> Int256+negate256 (Int256 a3 a2 a1 a0) =+ case plusCarrySum (complement a0) 1 of+ (c1, s0) -> case plusCarrySum (complement a1) c1 of+ (c2, s1) -> case plusCarrySum (complement a2) c2 of+ (c3, s2) -> case complement a3 + c3 of+ s3 -> Int256 s3 s2 s1 s0++{-# INLINABLE abs256 #-}+abs256 :: Int256 -> Int256+abs256 i@(Int256 a3 _ _ _)+ | testBit a3 63 = negate256 i+ | otherwise = i++{-# INLINABLE complement256 #-}+complement256 :: Int256 -> Int256+complement256 (Int256 a3 a2 a1 a0) = Int256 (complement a3) (complement a2) (complement a1) (complement a0)+++{-# INLINABLE signum256 #-}+signum256 :: Int256 -> Int256+signum256 (Int256 a3 a2 a1 a0)+ | a3 == 0 && a2 == 0 && a1 == 0 && a0 == 0 = zeroInt256+ | testBit a3 63 = minusOneInt256+ | otherwise = oneInt256+fromInteger256 :: Integer -> Int256+fromInteger256 i =+ Int256+ (fromIntegral $ i `shiftR` 192) (fromIntegral $ i `shiftR` 128)+ (fromIntegral $ i `shiftR` 64) (fromIntegral i)++-- -----------------------------------------------------------------------------+-- Functions for `Bits` instance.++{-# INLINABLE and256 #-}+and256 :: Int256 -> Int256 -> Int256+and256 (Int256 a3 a2 a1 a0) (Int256 b3 b2 b1 b0) =+ Int256 (a3 .&. b3) (a2 .&. b2) (a1 .&. b1) (a0 .&. b0)++{-# INLINABLE or256 #-}+or256 :: Int256 -> Int256 -> Int256+or256 (Int256 a3 a2 a1 a0) (Int256 b3 b2 b1 b0) =+ Int256 (a3 .|. b3) (a2 .|. b2) (a1 .|. b1) (a0 .|. b0)++{-# INLINABLE xor256 #-}+xor256 :: Int256 -> Int256 -> Int256+xor256 (Int256 a3 a2 a1 a0) (Int256 b3 b2 b1 b0) =+ Int256 (xor a3 b3) (xor a2 b2) (xor a1 b1) (xor a0 b0)++-- 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 :: Int256 -> Int -> Int256+shiftL256 w@(Int256 a3 a2 a1 a0) s+ | s == 0 = w+ | s == minBound = zeroInt256+ | s < 0 = shiftR256 w (negate s)+ | s >= 256 = zeroInt256+ | s > 192 = Int256 (a0 `shiftL` (s - 192)) 0 0 0+ | s == 192 = Int256 a0 0 0 0+ | s > 128 =+ Int256+ (a1 `shiftL` (s - 128) + a0 `shiftR` (192 - s))+ (a0 `shiftL` (s - 128)) 0 0+ | s == 128 = Int256 a1 a0 0 0+ | s > 64 =+ Int256+ (a2 `shiftL` (s - 64) + a1 `shiftR` (128 - s))+ (a1 `shiftL` (s - 64) + a0 `shiftR` (128 - s))+ (a0 `shiftL` (s - 64))+ 0+ | s == 64 = Int256 a2 a1 a0 0+ | otherwise =+ Int256+ (a3 `shiftL` s + a2 `shiftR` (64 - s))+ (a2 `shiftL` s + a1 `shiftR` (64 - s))+ (a1 `shiftL` s + a0 `shiftR` (64 - s))+ (a0 `shiftL` s)++{-# INLINABLE shiftR256 #-}+shiftR256 :: Int256 -> Int -> Int256+shiftR256 i@(Int256 a3 a2 a1 a0) s+ | s == 0 = i+ | s == minBound = zeroInt256+ | s < 0 = shiftL256 i (negate s)+ | topBitSetWord64 a3 = complement256 (shiftR256 (complement256 i) s)+ | s >= 256 = zeroInt256+ | s > 192 = Int256 0 0 0 (a3 `shiftR` (s - 192))+ | s == 192 = Int256 0 0 0 a3+ | s > 128 =+ Int256 0 0 (a3 `shiftR` (s - 128)) (a2 `shiftR` (s - 128) + a3 `shiftL` (192 - s))+ | s == 128 = Int256 0 0 a3 a2+ | s > 64 =+ Int256 0 (a3 `shiftR` (s - 64))+ (a2 `shiftR` (s - 64) + a3 `shiftL` (128 - s))+ (a1 `shiftR` (s - 64) + a2 `shiftL` (128 - s))+ | s == 64 = Int256 0 a3 a2 a1+ | otherwise =+ Int256+ (a3 `shiftR` s)+ (a2 `shiftR` s + a3 `shiftL` (64 - s))+ (a1 `shiftR` s + a2 `shiftL` (64 - s))+ (a0 `shiftR` s + a1 `shiftL` (64 - s))++{-# INLINABLE rotateL256 #-}+rotateL256 :: Int256 -> Int -> Int256+rotateL256 w@(Int256 a3 a2 a1 a0) r+ | r < 0 = rotateR256 w ((abs r) `mod` 256)+ | r == 0 = w+ | r >= 256 = rotateL256 w (r `mod` 256)+ | r >= 192 = rotateL256 (Int256 a0 a3 a2 a1) (r - 192)+ | r >= 128 = rotateL256 (Int256 a1 a0 a3 a2) (r - 128)+ | r >= 64 = rotateL256 (Int256 a2 a1 a0 a3) (r - 64)+ | otherwise =+ Int256+ (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 :: Int256 -> Int -> Int256+rotateR256 w@(Int256 a3 a2 a1 a0) r+ | r < 0 = rotateL256 w ((abs r) `mod` 256)+ | r == 0 = w+ | r >= 256 = rotateR256 w (r `mod` 256)+ | r >= 192 = rotateR256 (Int256 a2 a1 a0 a3) (r - 192)+ | r >= 128 = rotateR256 (Int256 a1 a0 a3 a2) (r - 128)+ | r >= 64 = rotateR256 (Int256 a0 a3 a2 a1) (r - 64)+ | otherwise =+ Int256+ (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 :: Int256 -> Int -> Bool+testBit256 (Int256 a3 a2 a1 a0) i+ | i < 0 = False+ | i >= 256 = False+ | i >= 192 = testBit a3 (i - 192)+ | i >= 128 = testBit a2 (i - 128)+ | i >= 64 = testBit a1 (i - 64)+ | otherwise = testBit a0 i++{-# INLINABLE bit256 #-}+bit256 :: Int -> Int256+bit256 indx+ | indx < 0 = zeroInt256+ | indx >= 256 = zeroInt256+ | otherwise = shiftL256 oneInt256 indx++{-# INLINABLE popCount256 #-}+popCount256 :: Int256 -> Int+popCount256 (Int256 a3 a2 a1 a0) =+ popCount a3 + popCount a2 + popCount a1 + popCount a0+++-- -----------------------------------------------------------------------------+-- Functions for `FiniteBits` instance.++{-# INLINABLE countLeadingZeros256 #-}+countLeadingZeros256 :: Int256 -> Int+countLeadingZeros256 (Int256 a3 a2 a1 a0) =+ case countLeadingZeros a3 of+ 64 -> case countLeadingZeros a2 of+ 64 -> case countLeadingZeros a1 of+ 64 -> 192 + countLeadingZeros a0+ res -> 128 + res+ res -> 64 + res+ res -> res++{-# INLINABLE countTrailingZeros256 #-}+countTrailingZeros256 :: Int256 -> Int+countTrailingZeros256 (Int256 a3 a2 a1 a0) =+ case countTrailingZeros a0 of+ 64 -> case countTrailingZeros a1 of+ 64 -> case countTrailingZeros a2 of+ 64 -> 192 + countTrailingZeros a3+ res -> 128 + res+ res -> 64 + res+ res -> res++-- -----------------------------------------------------------------------------+-- Functions for `Integral` instance.++-- TODO: This is inefficient, but the better version is rather+-- tedious to write out.+quotRem256 :: Int256 -> Int256 -> (Int256, Int256)+quotRem256 a b =+ let (x,y) = quotRem (toInteger256 a) (toInteger256 b)+ in (fromInteger256 x, fromInteger256 y)++divMod256 :: Int256 -> Int256 -> (Int256, Int256)+divMod256 a b = let (x,y) = divMod (toInteger256 a) (toInteger256 b)+ in (fromInteger256 x, fromInteger256 y)++toInteger256 :: Int256 -> Integer+toInteger256 i@(Int256 a3 a2 a1 a0)+ | popCount a3 == 64 && popCount a2 == 64 && popCount a1 == 64 && popCount a0 == 64 = -1+ | not (testBit a3 63) =+ (fromIntegral a3 `shiftL` 192)+ + (fromIntegral a2 `shiftL` 128)+ + (fromIntegral a1 `shiftL` 64)+ + fromIntegral a0+ | otherwise =+ case negate256 i of+ Int256 n3 n2 n1 n0 -> negate $+ (fromIntegral n3 `shiftL` 192)+ + (fromIntegral n2 `shiftL` 128)+ + (fromIntegral n1 `shiftL` 64)+ + fromIntegral n0++-- -----------------------------------------------------------------------------+-- Functions for `Storable` instance.++peek256 :: Ptr Int256 -> IO Int256+peek256 ptr =+ Int256 <$> peekElemOff (castPtr ptr) index3 <*> peekElemOff (castPtr ptr) index2+ <*> peekElemOff (castPtr ptr) index1 <*> peekElemOff (castPtr ptr) index0++peekElemOff256 :: Ptr Int256 -> Int -> IO Int256+peekElemOff256 ptr idx =+ Int256 <$> peekElemOff (castPtr ptr) (idx2 + index3)+ <*> peekElemOff (castPtr ptr) (idx2 + index2)+ <*> peekElemOff (castPtr ptr) (idx2 + index1)+ <*> peekElemOff (castPtr ptr) (idx2 + index0)+ where+ idx2 = 4 * idx++poke256 :: Ptr Int256 -> Int256 -> IO ()+poke256 ptr (Int256 a3 a2 a1 a0) = do+ pokeElemOff (castPtr ptr) index3 a3+ pokeElemOff (castPtr ptr) index2 a2+ pokeElemOff (castPtr ptr) index1 a1+ pokeElemOff (castPtr ptr) index0 a0++pokeElemOff256 :: Ptr Int256 -> Int -> Int256 -> IO ()+pokeElemOff256 ptr idx (Int256 a3 a2 a1 a0) = do+ pokeElemOff (castPtr ptr) (idx2 + index0) a0+ pokeElemOff (castPtr ptr) (idx2 + index1) a1+ pokeElemOff (castPtr ptr) (idx2 + index2) a2+ pokeElemOff (castPtr ptr) (idx2 + index3) a3+ where+ idx2 = 4 * idx++-- -----------------------------------------------------------------------------+-- Helpers.++{-# INLINE topBitSetWord64 #-}+topBitSetWord64 :: Word64 -> Bool+topBitSetWord64 w = testBit w 63++-- -----------------------------------------------------------------------------+-- Functions for `Prim` instance.++{-# INLINE sizeOf256# #-}+sizeOf256# :: Int256 -> Int#+sizeOf256# _ = 4# *# sizeOf# (0 :: Word64)++{-# INLINE alignment256# #-}+alignment256# :: Int256 -> Int#+alignment256# _ = 4# *# alignment# (0 :: Word64)++{-# INLINE indexByteArray256# #-}+indexByteArray256# :: ByteArray# -> Int# -> Int256+indexByteArray256# arr# i# =+ let i2# = 4# *# i#+ w = indexByteArray# arr# (i2# +# unInt index3)+ x = indexByteArray# arr# (i2# +# unInt index2)+ y = indexByteArray# arr# (i2# +# unInt index1)+ z = indexByteArray# arr# (i2# +# unInt index0)+ in Int256 w x y z++{-# INLINE readByteArray256# #-}+readByteArray256# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Int256 #)+readByteArray256# arr# i# =+ \s0 -> case readByteArray# arr# (i2# +# unInt index3) s0 of+ (# s1, w #) -> case readByteArray# arr# (i2# +# unInt index2) s1 of+ (# s2, x #) -> case readByteArray# arr# (i2# +# unInt index1) s2 of+ (# s3, y #) -> case readByteArray# arr# (i2# +# unInt index0) s3 of+ (# s4, z #) -> (# s4, Int256 w x y z #)+ where i2# = 4# *# i#++{-# INLINE writeByteArray256# #-}+writeByteArray256# :: MutableByteArray# s -> Int# -> Int256 -> State# s -> State# s+writeByteArray256# arr# i# (Int256 a b c d) =+ \s0 -> case writeByteArray# arr# (i2# +# unInt index3) a s0 of+ s1 -> case writeByteArray# arr# (i2# +# unInt index2) b s1 of+ s2 -> case writeByteArray# arr# (i2# +# unInt index1) c s2 of+ s3 -> case writeByteArray# arr# (i2# +# unInt index0) d s3 of+ s4 -> s4+ where i2# = 4# *# i#++{-# INLINE setByteArray256# #-}+setByteArray256# :: MutableByteArray# s -> Int# -> Int# -> Int256 -> State# s -> State# s+setByteArray256# = defaultSetByteArray#++{-# INLINE indexOffAddr256# #-}+indexOffAddr256# :: Addr# -> Int# -> Int256+indexOffAddr256# arr# i# =+ let i2# = 4# *# i#+ w = indexOffAddr# arr# (i2# +# unInt index3)+ x = indexOffAddr# arr# (i2# +# unInt index2)+ y = indexOffAddr# arr# (i2# +# unInt index1)+ z = indexOffAddr# arr# (i2# +# unInt index0)+ in Int256 w x y z++{-# INLINE readOffAddr256# #-}+readOffAddr256# :: Addr# -> Int# -> State# s -> (# State# s, Int256 #)+readOffAddr256# arr# i# =+ \s0 -> case readOffAddr# arr# (i2# +# unInt index3) s0 of+ (# s1, w #) -> case readOffAddr# arr# (i2# +# unInt index2) s1 of+ (# s2, x #) -> case readOffAddr# arr# (i2# +# unInt index1) s2 of+ (# s3, y #) -> case readOffAddr# arr# (i2# +# unInt index0) s3 of+ (# s4, z #) -> (# s4, Int256 w x y z #)+ where i2# = 4# *# i#++{-# INLINE writeOffAddr256# #-}+writeOffAddr256# :: Addr# -> Int# -> Int256 -> State# s -> State# s+writeOffAddr256# arr# i# (Int256 a b c d) =+ \s0 -> case writeOffAddr# arr# (i2# +# unInt index3) a s0 of+ s1 -> case writeOffAddr# arr# (i2# +# unInt index2) b s1 of+ s2 -> case writeOffAddr# arr# (i2# +# unInt index1) c s2 of+ s3 -> case writeOffAddr# arr# (i2# +# unInt index0) d s3 of+ s4 -> s4+ where i2# = 4# *# i#++{-# INLINE setOffAddr256# #-}+setOffAddr256# :: Addr# -> Int# -> Int# -> Int256 -> State# s -> State# s+setOffAddr256# = defaultSetOffAddr#++-- -----------------------------------------------------------------------------+-- Constants.++zeroInt256 :: Int256+zeroInt256 = Int256 0 0 0 0++oneInt256 :: Int256+oneInt256 = Int256 0 0 0 1++minusOneInt256 :: Int256+minusOneInt256 = Int256 maxBound maxBound maxBound maxBound++unInt :: Int -> Int#+unInt (I# i#) = i#++-- Use these indices to get the peek/poke ordering endian correct.+index0, index1, index2, index3 :: Int+#if WORDS_BIGENDIAN+index0 = 3+index1 = 2+index2 = 1+index3 = 0+#else+index0 = 0+index1 = 1+index2 = 2+index3 = 3+#endif
src/Data/WideWord/Word128.hs view
@@ -34,7 +34,7 @@ import Control.DeepSeq (NFData (..)) import Data.Bits (Bits (..), FiniteBits (..), shiftL)-import Data.Data (Data, Typeable)+import Data.Data (Data) import Data.Ix (Ix) #if ! MIN_VERSION_base(4,11,0) import Data.Semigroup ((<>))@@ -62,7 +62,7 @@ { word128Hi64 :: !Word64 , word128Lo64 :: !Word64 }- deriving (Eq, Data, Generic, Ix, Typeable)+ deriving (Eq, Data, Generic, Ix) instance Hashable Word128 where hashWithSalt s (Word128 a1 a2) = s `hashWithSalt` a1 `hashWithSalt` a2@@ -589,7 +589,7 @@ -- Use these indices to get the peek/poke ordering endian correct. index0, index1 :: Int-#if WORDS_BIGENDIAN+#ifdef WORDS_BIGENDIAN index0 = 1 index1 = 0 #else
src/Data/WideWord/Word256.hs view
@@ -22,6 +22,8 @@ ---- "modulo 2^256" result as one would expect from a fixed width unsigned word. ------------------------------------------------------------------------------- +#include <MachDeps.h>+ module Data.WideWord.Word256 ( Word256 (..) , showHexWord256@@ -31,7 +33,7 @@ import Control.DeepSeq (NFData (..)) import Data.Bits (Bits (..), FiniteBits (..), shiftL)-import Data.Data (Data, Typeable)+import Data.Data (Data) import Data.Ix (Ix) #if ! MIN_VERSION_base(4,11,0) import Data.Semigroup ((<>))@@ -63,7 +65,7 @@ , word256m0 :: !Word64 , word256lo :: !Word64 }- deriving (Eq, Data, Generic, Ix, Typeable)+ deriving (Eq, Data, Generic, Ix) instance Hashable Word256 where hashWithSalt s (Word256 a1 a2 a3 a4) =@@ -299,25 +301,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 +436,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 +445,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@@ -662,7 +662,7 @@ -- Use these indices to get the peek/poke ordering endian correct. index0, index1, index2, index3 :: Int-#if WORDS_BIGENDIAN+#ifdef WORDS_BIGENDIAN index0 = 3 index1 = 2 index2 = 1
src/Data/WideWord/Word64.hs view
@@ -1,8 +1,10 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-}+{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE StrictData #-} {-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE ViewPatterns #-} {-# OPTIONS_GHC -funbox-strict-fields #-} -----------------------------------------------------------------------------@@ -28,6 +30,7 @@ module Data.WideWord.Word64 ( mkWord64+ , oneWord64 , plusCarrySum , quotRem2Word64 , showHexWord64@@ -40,10 +43,10 @@ import Data.Bits (shiftL, shiftR) -import Data.WideWord.Compat- #if WORD_SIZE_IN_BITS == 32-import GHC.Prim (Word#, Word64#, uncheckedShiftRL64#, word64ToWord#, wordToWord32#)+import GHC.Exts (Word#, Word64#, uncheckedShiftRL64#, word64ToWord#)+#else+import Data.WideWord.Compat #endif import GHC.Word (Word32 (..), Word64 (..))@@ -66,6 +69,10 @@ word64Lo32 :: Word64 -> Word32 word64Lo32 = fromIntegral +{-# INLINE oneWord64 #-}+oneWord64 :: Word64+oneWord64 = 1+ {-# INLINE zeroWord64 #-} zeroWord64 :: Word64 zeroWord64 = 0@@ -86,8 +93,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)@@ -99,15 +106,9 @@ {-# INLINE plusCarrySum #-} plusCarrySum :: Word64 -> Word64 -> (Word64, Word64)-plusCarrySum (W64# a) (W64# b) =- (mkWord64 0 (W32# (wordToWord32# c2)), mkWord64 (W32# (wordToWord32# s1)) (W32# (wordToWord32# s0)))+plusCarrySum a b = (if ab < a then 1 else 0, ab) where- !(# a1, a0 #) = (# word64ToHiWord# a, word64ToWord# a #)- !(# b1, b0 #) = (# word64ToHiWord# b, word64ToWord# b #)- !(# c1, s0 #) = plusWord2# a0 b0- !(# c2a, s1a #) = plusWord2# b1 c1- !(# c2b, s1 #) = plusWord2# a1 s1a- !c2 = plusWord# c2a c2b+ ab = a + b quotRem2Word64 :: Word64 -> Word64 -> Word64 -> (Word64, Word64) quotRem2Word64 n1 n0 d =@@ -118,42 +119,29 @@ {-# INLINE subCarryDiff #-} subCarryDiff :: Word64 -> Word64 -> (Word64, Word64)-subCarryDiff (W64# a) (W64# b) =- (mkWord64 0 (W32# (wordToWord32# c2)), mkWord64 (W32# (wordToWord32# d1)) (W32# (wordToWord32# d0)))+subCarryDiff a b = (if ab > a then 1 else 0, ab) where- !(# a1, a0 #) = (# word64ToHiWord# a, word64ToWord# a #)- !(# b1, b0 #) = (# word64ToHiWord# b, word64ToWord# b #)- !(# d0, c1 #) = subWordC# a0 b0- !(# d1a, c2a #) = subWordC# a1 (int2Word# c1)- !(# d1, c2b #) = subWordC# d1a b1- !c2 = plusWord# (int2Word# c2a) (int2Word# c2b)+ ab = a - b +pattern W64 :: Word32 -> Word32 -> Word64+pattern W64 hi lo <- ((\x -> (word64Hi32 x, word64Lo32 x)) -> (hi, lo))+ where+ W64 hi lo = mkWord64 hi lo+{-# COMPLETE W64 #-}+ {-# INLINE timesCarryProd #-} timesCarryProd :: Word64 -> Word64 -> (Word64, Word64)-timesCarryProd (W64# a) (W64# b) =- (mkWord64 (W32# (wordToWord32# p3)) (W32# (wordToWord32# p2)), mkWord64 (W32# (wordToWord32# p1)) (W32# (wordToWord32# p0)))+timesCarryProd (W64 a1 a0) (W64 b1 b0) = (W64 p3 p2, W64 p1 p0) where- !(# a1, a0 #) = (# word64ToHiWord# a, word64ToWord# a #)- !(# b1, b0 #) = (# word64ToHiWord# b, word64ToWord# b #)-- !(# c1a, p0 #) = timesWord2# a0 b0-- !(# c2a, p1a #) = timesWord2# a1 b0- !(# c2b, p1b #) = timesWord2# a0 b1- !(# c2c, p1c #) = plusWord2# p1a p1b- !(# c2d, p1 #) = plusWord2# p1c c1a-- !(# c3a, p2a #) = timesWord2# a1 b1- !(# c3b, p2b #) = plusWord2# p2a c2a- !(# c3c, p2c #) = plusWord2# p2b c2b- !(# c3d, p2d #) = plusWord2# p2c c2c- !(# c3e, p2 #) = plusWord2# p2d c2d-- !p3 = c3a `plusWord#` c3b `plusWord#` c3c `plusWord#` c3d `plusWord#` c3e+ W64 c00 p00 = fromIntegral a0 * fromIntegral b0+ W64 c01 p01 = fromIntegral a0 * fromIntegral b1+ W64 c10 p10 = fromIntegral a1 * fromIntegral b0+ W64 c11 p11 = fromIntegral a1 * fromIntegral b1 -{-# INLINE word64ToHiWord# #-}-word64ToHiWord# :: Word64# -> Word#-word64ToHiWord# w = word64ToWord# (w `uncheckedShiftRL64#` 32#)+ p0 = p00+ W64 c1 p1 = fromIntegral c00 + fromIntegral p01 + fromIntegral p10+ W64 c2 p2 = fromIntegral c01 + fromIntegral c10 + fromIntegral p11 + fromIntegral c1+ p3 = c11 + c2 #else
test/Test/Data/WideWord/Gen.hs view
@@ -12,6 +12,14 @@ genInt128 = Int128 <$> genBiasedWord64 <*> genBiasedWord64 +genInt256 :: Gen Int256+genInt256 =+ Int256 <$> genBiasedWord64 <*> genBiasedWord64 <*> genBiasedWord64 <*> genBiasedWord64++genWord256 :: Gen Word256+genWord256 =+ Word256 <$> genBiasedWord64 <*> genBiasedWord64 <*> genBiasedWord64 <*> genBiasedWord64+ genWord32 :: Gen Word32 genWord32 = Gen.word32 Range.constantBounded
test/Test/Data/WideWord/Int128.hs view
@@ -78,20 +78,14 @@ prop_succ :: Property prop_succ = propertyCount $ do- i128 <- H.forAll genInt128- res <- liftIO (fmap toInteger128 <$> tryEvaluate (succ i128))- res === if i128 == maxBound- then Left "Enum.succ{Int128}: tried to take `succ' of maxBound"- else Right (succ $ toInteger128 i128)+ i128 <- H.forAll $ Gen.filter (< maxBound) genInt128+ toInteger128 (succ i128) === succ (toInteger128 i128) prop_pred :: Property prop_pred = propertyCount $ do- i128 <- H.forAll genInt128- res <- liftIO (fmap toInteger128 <$> tryEvaluate (pred i128))- res === if i128 == minBound- then Left "Enum.pred{Int128}: tried to take `pred' of minBound"- else Right $ pred (toInteger128 i128)+ i128 <- H.forAll $ Gen.filter (> minBound) genInt128+ toInteger128 (pred i128) === pred (toInteger128 i128) tryEvaluate :: a -> IO (Either String a) tryEvaluate x = do
+ test/Test/Data/WideWord/Int256.hs view
@@ -0,0 +1,370 @@+{-# LANGUAGE TemplateHaskell #-}+module Test.Data.WideWord.Int256+ ( 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.Int (Int32)+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 $ (,,,) <$> genBiasedWord64 <*> genBiasedWord64 <*> genBiasedWord64 <*> genBiasedWord64+ let w256 = Int256 hi m1 m0 lo+ (int256hi w256, int256m1 w256, int256m0 w256, int256lo w256) === (hi, m1, m0, lo)++prop_byte_swap :: Property+prop_byte_swap =+ propertyCount $ do+ h <- H.forAll genInt256+ l <- H.forAll $ Gen.filter (/= h) genInt256+ let i256 = Int256 (int256hi h) (int256m0 h) (int256m1 l) (int256lo l)+ swapped = byteSwapInt256 i256+ (byteSwapInt256 swapped)+ === (i256)++prop_derivied_eq_instance :: Property+prop_derivied_eq_instance =+ propertyCount $ do+ (a3, a2, a1, a0) <- H.forAll $ (,,,) <$> genBiasedWord64 <*> genBiasedWord64 <*> genBiasedWord64 <*> genBiasedWord64+ (b3, b2, b1, b0) <- H.forAll $ (,,,) <$> genBiasedWord64 <*> genBiasedWord64 <*> genBiasedWord64 <*> genBiasedWord64+ (Int256 a3 a2 a1 a0 == Int256 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 $ (,) <$> genInt256 <*> genInt256+ compare a b === compare (toInteger256 a) (toInteger256 b)++prop_show_instance :: Property+prop_show_instance =+ propertyCount $ do+ i256 <- H.forAll genInt256+ show i256 === show (toInteger256 i256)++prop_read_instance :: Property+prop_read_instance =+ propertyCount $ do+ (a3, a2, a1, a0) <- H.forAll $ (,,,) <$> genBiasedWord64 <*> genBiasedWord64 <*> genBiasedWord64 <*> genBiasedWord64+ read (show $ Int256 a3 a2 a1 a0) === Int256 a3 a2 a1 a0++prop_read_show :: Property+prop_read_show =+ propertyCount $ do+ (a3, a2, a1, a0) <- H.forAll $ (,,,) <$> genBiasedWord64 <*> genBiasedWord64 <*> genBiasedWord64 <*> genBiasedWord64+ H.tripping (Int256 a3 a2 a1 a0) show (Just . read)++prop_succ :: Property+prop_succ =+ propertyCount $ do+ i256 <- H.forAll $ Gen.filter (< maxBound) genInt256+ toInteger256 (succ i256) === succ (toInteger256 i256)++prop_pred :: Property+prop_pred =+ propertyCount $ do+ i256 <- H.forAll $ Gen.filter (> minBound) genInt256+ toInteger256 (pred i256) === pred (toInteger256 i256)++prop_toEnum_fromEnum :: Property+prop_toEnum_fromEnum =+ propertyCount $ do+ a0 <- H.forAll $ Gen.integral (Range.linear 0 (maxBound :: Int32))+ let i256 = Int256 0 0 0 (fromIntegral a0)+ e256 = fromEnum i256+ toInteger e256 === toInteger a0+ toInteger256 (toEnum e256 :: Int256) === toInteger a0++prop_addition :: Property+prop_addition =+ propertyCount $ do+ (a, b) <- H.forAll $ (,) <$> genInt256 <*> genInt256+ toInteger256 (a + b) === correctInt256 (toInteger256 a + toInteger256 b)++prop_subtraction :: Property+prop_subtraction =+ propertyCount $ do+ (a, b) <- H.forAll $ (,) <$> genInt256 <*> genInt256+ let ai = toInteger256 a+ bi = toInteger256 b+ expected = ai + (1 `shiftL` 256) - bi+ toInteger256 (a - b) === correctInt256 expected++prop_multiplication :: Property+prop_multiplication =+ propertyCount $ do+ (a, b) <- H.forAll $ (,) <$> genInt256 <*> genInt256+ toInteger256 (a * b) === correctInt256 (toInteger256 a * toInteger256 b)++prop_negate :: Property+prop_negate =+ propertyCount $ do+ i256 <- H.forAll genInt256+ toInteger256 (negate i256) === correctInt256 (negate $ toInteger256 i256)++prop_abs :: Property+prop_abs =+ propertyCount $ do+ i256 <- H.forAll genInt256+ toInteger256 (abs i256) === correctInt256 (abs $ toInteger256 i256)++prop_signum :: Property+prop_signum =+ propertyCount $ do+ i256 <- H.forAll genInt256+ toInteger256 (signum i256) === signum (toInteger256 i256)++prop_fromInteger :: Property+prop_fromInteger =+ propertyCount $ do+ (a3, a2, a1, a0) <- H.forAll $ (,,,) <$> genBiasedWord64 <*> genBiasedWord64 <*> genBiasedWord64 <*> genBiasedWord64+ let i256 = fromInteger $ mkInteger a3 a2 a1 a0+ (int256hi i256, int256m1 i256, int256m0 i256, int256lo i256) === (a3, a2, a1, a0)++prop_bitwise_and :: Property+prop_bitwise_and =+ propertyCount $ do+ (a, b) <- H.forAll $ (,) <$> genInt256 <*> genInt256+ toInteger256 (a .&. b) === (toInteger256 a .&. toInteger256 b)++prop_bitwise_or :: Property+prop_bitwise_or =+ propertyCount $ do+ (a, b) <- H.forAll $ (,) <$> genInt256 <*> genInt256+ toInteger256 (a .|. b) === (toInteger256 a .|. toInteger256 b)++prop_bitwise_xor :: Property+prop_bitwise_xor =+ propertyCount $ do+ (a, b) <- H.forAll $ (,) <$> genInt256 <*> genInt256+ toInteger256 (xor a b) === xor (toInteger256 a) (toInteger256 b)++prop_complement :: Property+prop_complement =+ propertyCount $ do+ i256 <- H.forAll genWord256+ H.assert $ complement i256 /= i256+ complement (complement i256) === i256++prop_logical_shift_left :: Property+prop_logical_shift_left =+ propertyCount $ do+ i256 <- H.forAll genInt256+ shift <- H.forAll $ Gen.int (Range.linear 0 260)+ toInteger256 (shiftL i256 shift) === correctInt256 (shiftL (toInteger256 i256) shift)++prop_logical_shift_right :: Property+prop_logical_shift_right =+ propertyCount $ do+ i256 <- H.forAll genInt256+ shift <- H.forAll $ Gen.int (Range.linear 0 260)+ toInteger256 (shiftR i256 shift) === shiftR (toInteger256 i256) shift++prop_logical_rotate_left :: Property+prop_logical_rotate_left =+ propertyCount $ do+ (a3, a2, a1, a0) <- H.forAll $ (,,,) <$> genBiasedWord64 <*> genBiasedWord64 <*> genBiasedWord64 <*> genBiasedWord64+ rot <- H.forAll $ Gen.int (Range.linearFrom 0 (-300) 300)+ toInteger (rotateL (Int256 a3 a2 a1 a0) rot) === correctInt256 (toInteger $ rotateL (Word256 a3 a2 a1 a0) rot)++prop_logical_rotate_right :: Property+prop_logical_rotate_right =+ propertyCount $ do+ (a3, a2, a1, a0) <- H.forAll $ (,,,) <$> genBiasedWord64 <*> genBiasedWord64 <*> genBiasedWord64 <*> genBiasedWord64+ rot <- H.forAll $ Gen.int (Range.linearFrom 0 (-300) 300)+ toInteger (rotateR (Int256 a3 a2 a1 a0) rot) === correctInt256 (toInteger $ rotateR (Word256 a3 a2 a1 a0) rot)++prop_shift_opposite :: Property+prop_shift_opposite =+ propertyCount $ do+ i256 <- H.forAll genInt256+ rot <- H.forAll $ Gen.int (Range.linearFrom 0 (-300) 300)+ shiftL i256 rot === shiftR i256 (negate rot)++prop_testBit :: Property+prop_testBit =+ propertyCount $ do+ i256 <- H.forAll genInt256+ idx <- H.forAll $ Gen.int (Range.linearFrom 0 (-200) 200)+ let expected+ | idx < 0 = False+ | idx >= 256 = False+ | otherwise = testBit (toInteger256 i256) idx+ testBit i256 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+ | idx == 255 = toInteger256 (minBound :: Int256)+ | otherwise = bit idx+ toInteger256 (bit idx :: Int256) === expected++prop_popCount :: Property+prop_popCount =+ propertyCount $ do+ (a3,a2, a1, a0) <- H.forAll $ (,,,) <$> genBiasedWord64 <*> genBiasedWord64 <*> genBiasedWord64 <*> genBiasedWord64+ popCount (Int256 a3 a2 a1 a0) === popCount a3 + popCount a2 + popCount a1 + popCount a0++prop_countLeadingZeros :: Property+prop_countLeadingZeros =+ propertyCount $ do+ (a3, a2, a1, a0) <- H.forAll $ (,,,) <$> genBiasedWord64 <*> genBiasedWord64 <*> genBiasedWord64 <*> genBiasedWord64+ 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 (Int256 a3 a2 a1 a0) === expected++prop_countTrailingZeros :: Property+prop_countTrailingZeros =+ propertyCount $ do+ (a3, a2, a1, a0) <- H.forAll $ (,,,) <$> genBiasedWord64 <*> genBiasedWord64 <*> genBiasedWord64 <*> genBiasedWord64+ 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 (Int256 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 genInt256+ den <- H.forAll $ Gen.filter (/= 0) genInt256+ 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 genInt256+ den <- H.forAll $ Gen.filter (/= 0) genInt256+ let (d, m) = divMod num den+ (toInteger256 d, toInteger256 m) === divMod (toInteger256 num) (toInteger256 den)++prop_roundtrip_binary :: Property+prop_roundtrip_binary =+ propertyCount $ do+ i256 <- H.forAll genInt256+ H.tripping i256 Binary.encode (Just . Binary.decode)++prop_peek_and_poke :: Property+prop_peek_and_poke =+ propertyCount $ do+ i256 <- H.forAll genInt256+ ar <- liftIO $+ allocaBytes (sizeOf zeroInt256) $ \ ptr -> do+ poke ptr i256+ peek ptr+ toInteger256 ar === toInteger256 i256++prop_peekElemOff_pokeElemOff :: Property+prop_peekElemOff_pokeElemOff =+ propertyCount $ do+ a256 <- H.forAll genInt256+ b256 <- H.forAll genInt256+ (ar, br) <- liftIO $+ allocaBytes (2 * sizeOf zeroInt256) $ \ 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)) genInt256+ as === primArrayToList (primArrayFromList as)++prop_WriteReadPrimArray :: Property+prop_WriteReadPrimArray =+ H.withTests 2000 . H.property $ do+ as <- H.forAll $ Gen.list (Range.linear 1 256) genInt256+ 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 genInt256+ 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 genInt256+ b256 <- H.forAll genInt256+ (ar, br) <- liftIO $+ allocaBytes (2 * sizeOf zeroInt256) $ \ 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++correctInt256 :: Integer -> Integer+correctInt256 x+ | x >= minBoundInt256 && x <= maxBoundInt256 = x+ | otherwise = toInteger (fromIntegral x :: Int256)+ where+ minBoundInt256 = fromIntegral (minBound :: Int256)+ maxBoundInt256 = fromIntegral (maxBound :: Int256)++toInteger256 :: Int256 -> Integer+toInteger256 = toInteger++-- -----------------------------------------------------------------------------++tests :: IO Bool+tests =+ H.checkParallel $$discover
test/Test/Data/WideWord/Word128.hs view
@@ -3,11 +3,9 @@ ( tests ) where -import Control.Exception (ArithException, SomeException, evaluate, try) import Control.Monad.IO.Class (liftIO) import Control.Monad (unless) -import Data.Bifunctor (first) import qualified Data.Binary as Binary import Data.Bits ((.&.), (.|.), bit, complement, countLeadingZeros, countTrailingZeros , popCount, rotateL, rotateR, shiftL, shiftR, testBit, xor)@@ -85,27 +83,14 @@ prop_succ :: Property prop_succ = propertyCount $ do- w128 <- H.forAll genWord128- res <- liftIO (fmap toInteger128 <$> tryEvaluate (succ w128))- res === if w128 == maxBound- then Left "Enum.succ{Word128}: tried to take `succ' of maxBound"- else Right (succ $ toInteger128 w128)+ w128 <- H.forAll $ Gen.filter (< maxBound) genWord128+ toInteger128 (succ w128) === succ (toInteger128 w128) prop_pred :: Property prop_pred = propertyCount $ do- w128 <- H.forAll genWord128- res <- liftIO (fmap toInteger128 <$> tryEvaluate (pred w128))- res === if w128 == 0- then Left "Enum.pred{Word128}: tried to take `pred' of minBound"- else Right $ pred (toInteger128 w128)--tryEvaluate :: a -> IO (Either String a)-tryEvaluate x = do- first renderException <$> try (evaluate x)- where- renderException :: SomeException -> String- renderException = show+ w128 <- H.forAll $ Gen.filter (> 0) genWord128+ toInteger128 (pred w128) === pred (toInteger128 w128) prop_toEnum_fromEnum :: Property prop_toEnum_fromEnum =@@ -256,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 =@@ -382,9 +369,6 @@ toInteger128 :: Word128 -> Integer toInteger128 = toInteger--showArithException :: ArithException -> String-showArithException = show -- -----------------------------------------------------------------------------
+ test/Test/Data/WideWord/Word256.hs view
@@ -0,0 +1,389 @@+{-# LANGUAGE TemplateHaskell #-}+module Test.Data.WideWord.Word256+ ( tests+ ) where++import Control.Monad.IO.Class (liftIO)+import Control.Monad (unless, when)++import qualified Data.Binary as Binary+import Data.Bits ((.&.), (.|.), bit, complement, countLeadingZeros, countTrailingZeros+ , popCount, rotateL, rotateR, shiftL, shiftR, testBit, xor, finiteBitSize)+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+ -- On 32-bit architecture `a0` can exceed maxBound :: Int32+ -- making fromEnum illegal. So limiting this test to 64-bit.+ when (finiteBitSize (0 :: Word) == 64) $ do+ 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
@@ -83,7 +83,7 @@ prop_pred :: Property prop_pred = propertyCount $ do- w64 <- H.forAll genWord64+ w64 <- H.forAll $ Gen.filter (> 0) genWord64 res <- liftIO (fmap toInteger64 <$> tryEvaluate (pred w64)) res === if w64 == 0 then Left "Enum.pred{Word64}: tried to take `pred' of minBound"@@ -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/laws.hs view
@@ -24,6 +24,7 @@ [ ("Int128", allLaws (Proxy :: Proxy Int128)) , ("Word64", allLaws (Proxy :: Proxy Word64)) , ("Word128", allLaws (Proxy :: Proxy Word128))+ , ("Int256", allLaws (Proxy :: Proxy Int256)) , ("Word256", allLaws (Proxy :: Proxy Word256)) ] @@ -87,6 +88,28 @@ instance Arbitrary Int128 where arbitrary = Int128 <$> arbitrary <*> arbitrary +instance Arbitrary Int256 where+ arbitrary =+ Int256+ <$> arbitraryBoundedIntegral <*> arbitraryBoundedIntegral+ <*> arbitraryBoundedIntegral <*> arbitraryBoundedIntegral+ shrink x+ | x == 0 = []+ | x == 1 = [0]+ | x == 2 = [0,1]+ | x == 3 = [0,1,2]+ | otherwise =+ let y = x `shiftR` 1+ z = y + 1+ w = div (x * 9) 10+ p = div (x * 7) 8+ in catMaybes+ [ if y < x then Just y else Nothing+ , if z < x then Just z else Nothing+ , if w < x then Just w else Nothing+ , if p < x then Just p else Nothing+ ]+ -- These are used to make sure that 'Num' behaves properly. instance Semiring Word128 where zero = 0@@ -106,6 +129,12 @@ plus = (+) times = (*) +instance Semiring Int256 where+ zero = 0+ one = 1+ plus = (+)+ times = (*)+ -- These are used to make sure that plus is associative instance Semigroup Word128 where (<>) = (+)@@ -119,3 +148,5 @@ instance Semigroup Int128 where (<>) = (+) +instance Semigroup Int256 where+ (<>) = (+)
− 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,18 @@+import Control.Monad (unless)++import System.Exit (exitFailure)++import qualified Test.Data.WideWord.Word256+import qualified Test.Data.WideWord.Int256++main :: IO ()+main = runTests+ [ Test.Data.WideWord.Word256.tests+ , Test.Data.WideWord.Int256.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.6.0+version: 0.1.9.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@@ -25,7 +25,8 @@ 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.4, GHC == 9.4.7, GHC == 9.6.2, GHC == 9.8.1+ GHC == 9.2.4, GHC == 9.4.7, GHC == 9.6.7, GHC == 9.8.4, GHC == 9.10.2,+ GHC == 9.12.2 library default-language: Haskell2010@@ -35,41 +36,72 @@ exposed-modules: Data.WideWord Data.WideWord.Int128+ Data.WideWord.Int256 Data.WideWord.Word64 Data.WideWord.Word128 Data.WideWord.Word256 other-modules: Data.WideWord.Compat - build-depends: base >= 4.9 && < 4.20+ 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.5+ , 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+ Test.Data.WideWord.Int256++ build-depends: base+ , binary+ , hedgehog+ , 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 && < 0.13- , ghc-prim- , hedgehog >= 1.0 && < 1.5+ , hedgehog , 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.8+ , primitive+ , wide-word+ test-suite laws default-language: Haskell2010 ghc-options: -Wall@@ -79,7 +111,7 @@ hs-source-dirs: test build-depends: base- , QuickCheck >= 2.9.2 && < 2.15+ , QuickCheck >= 2.9.2 && < 2.18 , quickcheck-classes >= 0.6.3 && < 0.7.0 , primitive , semirings >= 0.2 && < 0.8