wide-word 0.1.8.1 → 0.1.9.0
raw patch · 13 files changed
+1159/−53 lines, 13 filesdep ~QuickCheckdep ~hedgehog
Dependency ranges changed: QuickCheck, hedgehog
Files
- ChangeLog.md +6/−0
- src/Data/WideWord.hs +1/−0
- src/Data/WideWord/Int128.hs +3/−1
- src/Data/WideWord/Int256.hs +700/−0
- src/Data/WideWord/Word128.hs +1/−1
- src/Data/WideWord/Word256.hs +3/−1
- src/Data/WideWord/Word64.hs +24/−41
- test/Test/Data/WideWord/Gen.hs +4/−0
- test/Test/Data/WideWord/Int256.hs +370/−0
- test/Test/Data/WideWord/Word256.hs +7/−4
- test/laws.hs +31/−0
- test/test256.hs +2/−0
- wide-word.cabal +7/−5
ChangeLog.md view
@@ -1,5 +1,11 @@ # 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.
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/Int128.hs view
@@ -22,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@@ -591,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
@@ -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@@ -660,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 #-} -----------------------------------------------------------------------------@@ -41,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 (..))@@ -104,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 =@@ -123,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,10 @@ genInt128 = Int128 <$> genBiasedWord64 <*> genBiasedWord64 +genInt256 :: Gen Int256+genInt256 =+ Int256 <$> genBiasedWord64 <*> genBiasedWord64 <*> genBiasedWord64 <*> genBiasedWord64+ genWord256 :: Gen Word256 genWord256 = Word256 <$> genBiasedWord64 <*> genBiasedWord64 <*> genBiasedWord64 <*> genBiasedWord64
+ 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/Word256.hs view
@@ -4,11 +4,11 @@ ) where import Control.Monad.IO.Class (liftIO)-import Control.Monad (unless)+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)+ , popCount, rotateL, rotateR, shiftL, shiftR, testBit, xor, finiteBitSize) import Data.Primitive.PrimArray import Data.Primitive.Ptr import Data.Word (Word64, Word8)@@ -99,8 +99,11 @@ 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+ -- 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 =
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/test256.hs view
@@ -3,10 +3,12 @@ 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 ()
wide-word.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: wide-word-version: 0.1.8.1+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@@ -36,6 +36,7 @@ exposed-modules: Data.WideWord Data.WideWord.Int128+ Data.WideWord.Int256 Data.WideWord.Word64 Data.WideWord.Word128 Data.WideWord.Word256@@ -58,10 +59,11 @@ other-modules: Test.Data.WideWord.Gen Test.Data.WideWord.Word256+ Test.Data.WideWord.Int256 build-depends: base , binary- , hedgehog >= 1.0 && < 1.6+ , hedgehog , primitive , wide-word @@ -79,7 +81,7 @@ build-depends: base , binary- , hedgehog >= 1.0 && < 1.6+ , hedgehog , primitive , wide-word @@ -96,7 +98,7 @@ build-depends: base , binary- , hedgehog >= 1.0 && < 1.6+ , hedgehog >= 1.0 && < 1.8 , primitive , wide-word @@ -109,7 +111,7 @@ hs-source-dirs: test build-depends: base- , QuickCheck >= 2.9.2 && < 2.17+ , QuickCheck >= 2.9.2 && < 2.18 , quickcheck-classes >= 0.6.3 && < 0.7.0 , primitive , semirings >= 0.2 && < 0.8