wide-word 0.1.1.2 → 0.1.3.0
raw patch · 8 files changed
+302/−53 lines, 8 filesdep +hashabledep ~basedep ~hedgehog
Dependencies added: hashable
Dependency ranges changed: base, hedgehog
Files
- ChangeLog.md +4/−0
- src/Data/WideWord/Compat.hs +136/−0
- src/Data/WideWord/Int128.hs +47/−9
- src/Data/WideWord/Word128.hs +42/−12
- src/Data/WideWord/Word256.hs +57/−22
- test/Test/Data/WideWord/Int128.hs +2/−2
- test/Test/Data/WideWord/Word128.hs +2/−2
- wide-word.cabal +12/−6
ChangeLog.md view
@@ -1,5 +1,9 @@ # Revision history for wide-word +## 0.1.2.0 -- 2022-??-??++* Add Hashable instances for Int128, Word128, and Word256.+ ## 0.1.1.2 -- 2020-12-26 * Derive Generic for Int128, Word128 and Word256.
+ src/Data/WideWord/Compat.hs view
@@ -0,0 +1,136 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE StrictData #-}+#if MIN_VERSION_base(4,17,0)+{-# LANGUAGE UnboxedTuples #-}+#endif++-- | This module exists to centralize compatibility shims for GHC 9.4.+module Data.WideWord.Compat+ ( plusWord2#+ , timesWord2#+ , int2Word#+ , minusWord#+ , subWordC#+ , not#+ , isZeroWord#+ , or#+ , and#+ , xor#+ , timesWord#+ , plusWord#+ , word2Int#+ , quotRemWord2#+ , compatWordLiteral#+ , compatIntLiteral#+ , compatCaseOnWordLiteral#+ , compatCaseOnIntLiteral#+ ) where++#if MIN_VERSION_base(4,17,0)+import qualified GHC.Base+import GHC.Prim (Word64#, wordToWord64#, word64ToWord#, Int64#)+#else+import GHC.Base (Int#, Word#, quotRemWord2#, int2Word#, subWordC#, plusWord2#, or#, minusWord#,+ timesWord2#, word2Int#, xor#, and#, not#, plusWord#, timesWord#)+#endif++#if MIN_VERSION_base(4,17,0)+plusWord2# :: Word64# -> Word64# -> (# Word64#, Word64# #)+plusWord2# a b =+ case GHC.Base.plusWord2# (word64ToWord# a) (word64ToWord# b) of+ (# a', b' #) ->+ (# wordToWord64# a', wordToWord64# b' #)++timesWord2# :: Word64# -> Word64# -> (# Word64#, Word64# #)+timesWord2# a b =+ case GHC.Base.timesWord2# (word64ToWord# a) (word64ToWord# b) of+ (# a', b' #) ->+ (# wordToWord64# a', wordToWord64# b' #)++int2Word# :: Int64# -> Word64#+int2Word# = GHC.Base.int64ToWord64#++minusWord# :: Word64# -> Word64# -> Word64#+minusWord# a b =+ wordToWord64# (GHC.Base.minusWord# (word64ToWord# a) (word64ToWord# b))++subWordC# :: Word64# -> Word64# -> (# Word64#, Int64# #)+subWordC# a b =+ case GHC.Base.subWordC# (word64ToWord# a) (word64ToWord# b) of+ (# a', b' #) ->+ (# wordToWord64# a', GHC.Base.intToInt64# b' #)++not# :: Word64# -> Word64#+not# = GHC.Base.not64#++or# :: Word64# -> Word64# -> Word64#+or# = GHC.Base.or64#++xor# :: Word64# -> Word64# -> Word64#+xor# = GHC.Base.xor64#++and# :: Word64# -> Word64# -> Word64#+and# = GHC.Base.and64#++timesWord# :: Word64# -> Word64# -> Word64#+timesWord# = GHC.Base.timesWord64#++plusWord# :: Word64# -> Word64# -> Word64#+plusWord# = GHC.Base.plusWord64#++word2Int# :: Word64# -> Int64#+word2Int# = GHC.Base.word64ToInt64#++quotRemWord2# :: Word64# -> Word64# -> Word64# -> (# Word64#, Word64# #)+quotRemWord2# a b c =+ case GHC.Base.quotRemWord2# (word64ToWord# a) (word64ToWord# b) (word64ToWord# c) of+ (# x, y #) -> (# wordToWord64# x, wordToWord64# y #)+#endif++isZeroWord#+#if MIN_VERSION_base(4,17,0)+ :: Word64# -> Bool+isZeroWord# a = GHC.Base.isTrue# (GHC.Base.eqWord# (word64ToWord# a) 0##)+#else+ :: Word# -> Bool+isZeroWord# 0## = True+isZeroWord# _ = False+#endif++compatWordLiteral#+#if MIN_VERSION_base(4,17,0)+ :: GHC.Base.Word# -> Word64#+compatWordLiteral# = wordToWord64#+#else+ :: Word# -> Word#+compatWordLiteral# a = a+#endif++compatIntLiteral#+#if MIN_VERSION_base(4,17,0)+ :: GHC.Base.Int# -> Int64#+compatIntLiteral# = GHC.Base.intToInt64#+#else+ :: Int# -> Int#+compatIntLiteral# a = a+#endif++compatCaseOnWordLiteral#+#if MIN_VERSION_base(4,17,0)+ :: Word64# -> GHC.Base.Word#+compatCaseOnWordLiteral# = word64ToWord#+#else+ :: Word# -> Word#+compatCaseOnWordLiteral# a = a+#endif++compatCaseOnIntLiteral#+#if MIN_VERSION_base(4,17,0)+ :: Int64# -> GHC.Base.Int#+compatCaseOnIntLiteral# = GHC.Base.int64ToInt#+#else+ :: Int# -> Int#+compatCaseOnIntLiteral# a = a+#endif+
src/Data/WideWord/Int128.hs view
@@ -48,8 +48,7 @@ import Foreign.Ptr (Ptr, castPtr) import Foreign.Storable (Storable (..)) -import GHC.Base (Int (..), and#, int2Word#, minusWord#, not#, or#, plusWord#, plusWord2#- , subWordC#, timesWord#, timesWord2#, word2Int#, xor#)+import GHC.Base (Int (..)) import GHC.Enum (predError, succError) import GHC.Exts ((+#), (*#), State#, Int#, Addr#, ByteArray#, MutableByteArray#) import GHC.Generics@@ -63,12 +62,25 @@ import Data.Primitive.Types (Prim (..), defaultSetByteArray#, defaultSetOffAddr#) +import Data.Hashable (Hashable,hashWithSalt)++import Data.WideWord.Compat++#if MIN_VERSION_base(4,17,0)+#define ONE (wordToWord64# 1##)+#else+#define ONE (1##)+#endif+ data Int128 = Int128 { int128Hi64 :: !Word64 , int128Lo64 :: !Word64 } deriving (Eq, Data, Generic, Ix, Typeable) +instance Hashable Int128 where+ hashWithSalt s (Int128 a1 a2) = s `hashWithSalt` a1 `hashWithSalt` a2+ byteSwapInt128 :: Int128 -> Int128 byteSwapInt128 (Int128 a1 a0) = Int128 (byteSwap64 a0) (byteSwap64 a1) @@ -184,15 +196,41 @@ -- Rewrite rules. {-# RULES-"fromIntegral :: Int128 -> Int128" fromIntegral = id :: Int128 -> Int128-"fromIntegral :: Word128 -> Int128" fromIntegral = \(Word128 a1 a0) -> Int128 a1 a0-"fromIntegral :: Int128 -> Word128" fromIntegral = \(Int128 a1 a0) -> Word128 a1 a0--"fromIntegral :: Word -> Int128" fromIntegral = Int128 0 . (fromIntegral :: Word -> Word64)-"fromIntegral :: Word32 -> Int128" fromIntegral = Int128 0 . (fromIntegral :: Word32 -> Word64)+"fromIntegral :: Int -> Int128" fromIntegral = fromInt+"fromIntegral :: Word -> Int128" fromIntegral = fromWord+"fromIntegral :: Word32 -> Int128" fromIntegral = fromWord32 "fromIntegral :: Word64 -> Int128" fromIntegral = Int128 0++"fromIntegral :: Int128 -> Int" fromIntegral = toInt+"fromIntegral :: Int128 -> Word" fromIntegral = toWord+"fromIntegral :: Int128 -> Word32" fromIntegral = toWord32+"fromIntegral :: Int128 -> Word64" fromIntegral = \(Int128 _ w) -> w #-} +{-# INLINE fromInt #-}+fromInt :: Int -> Int128+fromInt = Int128 0 . fromIntegral++{-# INLINE fromWord #-}+fromWord :: Word -> Int128+fromWord = Int128 0 . fromIntegral++{-# INLINE fromWord32 #-}+fromWord32 :: Word32 -> Int128+fromWord32 = Int128 0 . fromIntegral++{-# INLINE toInt #-}+toInt :: Int128 -> Int+toInt (Int128 _ w) = fromIntegral w++{-# INLINE toWord #-}+toWord :: Int128 -> Word+toWord (Int128 _ w) = fromIntegral w++{-# INLINE toWord32 #-}+toWord32 :: Int128 -> Word32+toWord32 (Int128 _ w) = fromIntegral w+ -- ----------------------------------------------------------------------------- -- Functions for `Ord` instance. @@ -264,7 +302,7 @@ {-# INLINABLE negate128 #-} negate128 :: Int128 -> Int128 negate128 (Int128 (W64# a1) (W64# a0)) =- case plusWord2# (not# a0) 1## of+ case plusWord2# (not# a0) (compatWordLiteral# 1##) of (# c, s #) -> Int128 (W64# (plusWord# (not# a1) c)) (W64# s) {-# INLINABLE abs128 #-}
src/Data/WideWord/Word128.hs view
@@ -43,8 +43,7 @@ import Foreign.Ptr (Ptr, castPtr) import Foreign.Storable (Storable (..)) -import GHC.Base (Int (..), and#, int2Word#, minusWord#, not#, or#, plusWord#, plusWord2#- , quotRemWord2#, subWordC#, timesWord#, timesWord2#, xor#)+import GHC.Base (Int (..)) import GHC.Enum (predError, succError) import GHC.Exts ((*#), (+#), Int#, State#, ByteArray#, MutableByteArray#, Addr#) import GHC.Generics@@ -55,16 +54,22 @@ import GHC.IntWord64 #endif +import Data.WideWord.Compat import Numeric (showHex) import Data.Primitive.Types (Prim (..), defaultSetByteArray#, defaultSetOffAddr#) +import Data.Hashable (Hashable,hashWithSalt)+ data Word128 = Word128 { word128Hi64 :: !Word64 , word128Lo64 :: !Word64 } deriving (Eq, Data, Generic, Ix, Typeable) +instance Hashable Word128 where+ hashWithSalt s (Word128 a1 a2) = s `hashWithSalt` a1 `hashWithSalt` a2+ byteSwapWord128 :: Word128 -> Word128 byteSwapWord128 (Word128 a1 a0) = Word128 (byteSwap64 a0) (byteSwap64 a1) @@ -182,17 +187,41 @@ {-# RULES "fromIntegral :: Word128 -> Word128" fromIntegral = id :: Word128 -> Word128 -"fromIntegral :: Int -> Word128" fromIntegral = Word128 0 . (fromIntegral :: Int -> Word64)-"fromIntegral :: Word -> Word128" fromIntegral = Word128 0 . (fromIntegral :: Word -> Word64)-"fromIntegral :: Word32 -> Word128" fromIntegral = Word128 0 . (fromIntegral :: Word32 -> Word64)+"fromIntegral :: Int -> Word128" fromIntegral = fromInt+"fromIntegral :: Word -> Word128" fromIntegral = fromWord+"fromIntegral :: Word32 -> Word128" fromIntegral = fromWord32 "fromIntegral :: Word64 -> Word128" fromIntegral = Word128 0 -"fromIntegral :: Word128 -> Int" fromIntegral = \(Word128 _ w) -> fromIntegral w :: Int-"fromIntegral :: Word128 -> Word" fromIntegral = \(Word128 _ w) -> fromIntegral w :: Word-"fromIntegral :: Word128 -> Word32" fromIntegral = \(Word128 _ w) -> fromIntegral w :: Word32+"fromIntegral :: Word128 -> Int" fromIntegral = toInt+"fromIntegral :: Word128 -> Word" fromIntegral = toWord+"fromIntegral :: Word128 -> Word32" fromIntegral = toWord32 "fromIntegral :: Word128 -> Word64" fromIntegral = \(Word128 _ w) -> w #-} +{-# INLINE fromInt #-}+fromInt :: Int -> Word128+fromInt = Word128 0 . fromIntegral++{-# INLINE fromWord #-}+fromWord :: Word -> Word128+fromWord = Word128 0 . fromIntegral++{-# INLINE fromWord32 #-}+fromWord32 :: Word32 -> Word128+fromWord32 = Word128 0 . fromIntegral++{-# INLINE toInt #-}+toInt :: Word128 -> Int+toInt (Word128 _ w) = fromIntegral w++{-# INLINE toWord #-}+toWord :: Word128 -> Word+toWord (Word128 _ w) = fromIntegral w++{-# INLINE toWord32 #-}+toWord32 :: Word128 -> Word32+toWord32 (Word128 _ w) = fromIntegral w+ -- ----------------------------------------------------------------------------- -- Functions for `Ord` instance. @@ -261,13 +290,15 @@ {-# INLINABLE negate128 #-} negate128 :: Word128 -> Word128 negate128 (Word128 (W64# a1) (W64# a0)) =- case plusWord2# (not# a0) 1## of+ case plusWord2# (not# a0) (compatWordLiteral# 1##) of (# c, s #) -> Word128 (W64# (plusWord# (not# a1) c)) (W64# s) {-# INLINABLE signum128 #-} signum128 :: Word128 -> Word128-signum128 (Word128 (W64# 0##) (W64# 0##)) = zeroWord128-signum128 _ = oneWord128+signum128 (Word128 (W64# a) (W64# b)) =+ if isZeroWord# a && isZeroWord# b+ then zeroWord128+ else oneWord128 fromInteger128 :: Integer -> Word128 fromInteger128 i =@@ -435,7 +466,6 @@ quotRemWord64 (W64# n1) (W64# n0) (W64# d) = case quotRemWord2# n1 n0 d of (# q, r #) -> (W64# q, W64# r)- {-# INLINE quotRemTwo #-} quotRemTwo :: Word64 -> Word64 -> (Word128, Word128)
src/Data/WideWord/Word256.hs view
@@ -42,14 +42,15 @@ import Foreign.Ptr (Ptr, castPtr) import Foreign.Storable (Storable (..)) -import GHC.Base (Int (..), and#, minusWord#, not#, or#, plusWord#, plusWord2#- , subWordC#, timesWord#, timesWord2#, xor#)+import GHC.Base (Int (..)) import GHC.Enum (predError, succError) import GHC.Exts ((*#), (+#), Int#, State#, ByteArray#, MutableByteArray#, Addr#) import GHC.Generics import GHC.Real ((%)) import GHC.Word (Word64 (..), Word32) +import Data.WideWord.Compat+ #if WORD_SIZE_IN_BITS < 64 import GHC.IntWord64 #endif@@ -57,6 +58,7 @@ import Numeric (showHex) import Data.Primitive.Types (Prim (..), defaultSetByteArray#, defaultSetOffAddr#)+import Data.Hashable (Hashable,hashWithSalt) data Word256 = Word256 { word256hi :: !Word64@@ -66,6 +68,10 @@ } deriving (Eq, Data, Generic, Ix, Typeable) +instance Hashable Word256 where+ hashWithSalt s (Word256 a1 a2 a3 a4) =+ s `hashWithSalt` a1 `hashWithSalt` a2 `hashWithSalt` a3 `hashWithSalt` a4+ showHexWord256 :: Word256 -> String showHexWord256 (Word256 a3 a2 a1 a0) | a3 == 0 = if a2 == 0@@ -190,17 +196,41 @@ {-# RULES "fromIntegral :: Word256 -> Word256" fromIntegral = id :: Word256 -> Word256 -"fromIntegral :: Int -> Word256" fromIntegral = Word256 0 0 0 . (fromIntegral :: Int -> Word64)-"fromIntegral :: Word -> Word256" fromIntegral = Word256 0 0 0 . (fromIntegral :: Word -> Word64)-"fromIntegral :: Word32 -> Word256" fromIntegral = Word256 0 0 0 . (fromIntegral :: Word32 -> Word64)+"fromIntegral :: Int -> Word256" fromIntegral = fromInt+"fromIntegral :: Word -> Word256" fromIntegral = fromWord+"fromIntegral :: Word32 -> Word256" fromIntegral = fromWord32 "fromIntegral :: Word64 -> Word256" fromIntegral = Word256 0 0 0 -"fromIntegral :: Word256 -> Int" fromIntegral = \(Word256 _ _ _ w) -> fromIntegral w :: Int-"fromIntegral :: Word256 -> Word" fromIntegral = \(Word256 _ _ _ w) -> fromIntegral w :: Word-"fromIntegral :: Word256 -> Word32" fromIntegral = \(Word256 _ _ _ w) -> fromIntegral w :: Word32+"fromIntegral :: Word256 -> Int" fromIntegral = toInt+"fromIntegral :: Word256 -> Word" fromIntegral = toWord+"fromIntegral :: Word256 -> Word32" fromIntegral = toWord32 "fromIntegral :: Word256 -> Word64" fromIntegral = \(Word256 _ _ _ w) -> w #-} +{-# INLINE fromInt #-}+fromInt :: Int -> Word256+fromInt = Word256 0 0 0 . fromIntegral++{-# INLINE fromWord #-}+fromWord :: Word -> Word256+fromWord = Word256 0 0 0 . fromIntegral++{-# INLINE fromWord32 #-}+fromWord32 :: Word32 -> Word256+fromWord32 = Word256 0 0 0 . fromIntegral++{-# INLINE toInt #-}+toInt :: Word256 -> Int+toInt (Word256 _ _ _ w) = fromIntegral w++{-# INLINE toWord #-}+toWord :: Word256 -> Word+toWord (Word256 _ _ _ w) = fromIntegral w++{-# INLINE toWord32 #-}+toWord32 :: Word256 -> Word32+toWord32 (Word256 _ _ _ w) = fromIntegral w+ -- ----------------------------------------------------------------------------- -- Functions for `Ord` instance. @@ -269,23 +299,23 @@ where !(# s0, v1 #) = subWordC# a0 b0 !(# s1, v2 #) =- case v1 of+ case compatCaseOnIntLiteral# v1 of 0# -> subWordC# a1 b1 _ ->- case a1 of- 0## -> (# minusWord# 0xFFFFFFFFFFFFFFFF## b1, 1# #)- _ -> subWordC# (minusWord# a1 1##) b1+ case compatCaseOnWordLiteral# a1 of+ 0## -> (# minusWord# (compatWordLiteral# 0xFFFFFFFFFFFFFFFF##) b1, compatIntLiteral# 1# #)+ _ -> subWordC# (minusWord# a1 (compatWordLiteral# 1##)) b1 !(# s2, v3 #) =- case v2 of+ case compatCaseOnIntLiteral# v2 of 0# -> subWordC# a2 b2 _ ->- case a2 of- 0## -> (# minusWord# 0xFFFFFFFFFFFFFFFF## b2, 1# #)- _ -> subWordC# (minusWord# a2 1##) b2+ case compatCaseOnWordLiteral# a2 of+ 0## -> (# minusWord# (compatWordLiteral# 0xFFFFFFFFFFFFFFFF##) b2, compatIntLiteral# 1# #)+ _ -> subWordC# (minusWord# a2 (compatWordLiteral# 1##)) b2 !s3 =- case v3 of+ case compatCaseOnIntLiteral# v3 of 0# -> minusWord# a3 b3- _ -> minusWord# (minusWord# a3 1##) b3+ _ -> minusWord# (minusWord# a3 (compatWordLiteral# 1##)) b3 times256 :: Word256 -> Word256 -> Word256 times256 (Word256 (W64# a3) (W64# a2) (W64# a1) (W64# a0))@@ -323,7 +353,7 @@ {-# INLINABLE negate256 #-} negate256 :: Word256 -> Word256 negate256 (Word256 (W64# a3) (W64# a2) (W64# a1) (W64# a0)) =- case plusWord2# (not# a0) 1## of+ case plusWord2# (not# a0) (compatWordLiteral# 1##) of (# c1, s0 #) -> case plusWord2# (not# a1) c1 of (# c2, s1 #) -> case plusWord2# (not# a2) c2 of (# c3, s2 #) -> case plusWord# (not# a3) c3 of@@ -331,8 +361,13 @@ {-# INLINABLE signum256 #-} signum256 :: Word256 -> Word256-signum256 (Word256 (W64# 0##) (W64# 0##) (W64# 0##) (W64# 0##)) = zeroWord256-signum256 _ = oneWord256+signum256 (Word256 (W64# a) (W64# b) (W64# c) (W64# d))+ | isZeroWord# a+ , isZeroWord# b+ , isZeroWord# c+ , isZeroWord# d+ = zeroWord256+ | otherwise = oneWord256 fromInteger256 :: Integer -> Word256 fromInteger256 i = Word256@@ -502,7 +537,7 @@ (toInteger a3 `shiftL` 192) + (toInteger a2 `shiftL` 128) + (toInteger a1 `shiftL` 64)- + (toInteger a0)+ + toInteger a0 -- ----------------------------------------------------------------------------- -- Functions for `Storable` instance.
test/Test/Data/WideWord/Int128.hs view
@@ -295,14 +295,14 @@ prop_ToFromPrimArray :: Property prop_ToFromPrimArray =- propertyCount $ do+ H.withTests 2000 . H.property $ do as <- H.forAll $ Gen.list (fromIntegral <$> (Range.linearBounded :: Range.Range Word8)) genInt128 as === primArrayToList (primArrayFromList as) prop_WriteReadPrimArray :: Property prop_WriteReadPrimArray =- propertyCount $ do+ H.withTests 2000 . H.property $ do as <- H.forAll $ Gen.list (Range.linear 1 256) genInt128 unless (null as) $ do let len = length as
test/Test/Data/WideWord/Word128.hs view
@@ -316,7 +316,7 @@ prop_ToFromPrimArray :: Property prop_ToFromPrimArray =- propertyCount $ do+ H.withTests 2000 . H.property $ do as <- H.forAll $ Gen.list (fromIntegral <$> (Range.linearBounded :: Range.Range Word8)) genWord128 as === primArrayToList (primArrayFromList as)@@ -324,7 +324,7 @@ prop_WriteReadPrimArray :: Property prop_WriteReadPrimArray =- propertyCount $ do+ H.withTests 2000 . H.property $ do as <- H.forAll $ Gen.list (Range.linear 1 256) genWord128 unless (null as) $ do let len = length as
wide-word.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: wide-word-version: 0.1.1.2+version: 0.1.3.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.0.2, GHC == 8.2.2, GHC == 8.4.4,- GHC == 8.6.5, GHC == 8.8.3, GHC == 8.10.1+ GHC == 8.6.5, GHC == 8.8.4, GHC == 8.10.7,+ GHC == 9.0.2, GHC == 9.2.1 library default-language: Haskell2010@@ -38,9 +39,14 @@ Data.WideWord.Word256 Data.WideWord.Int128 - build-depends: base >= 4.9 && < 4.15+ other-modules: Data.WideWord.Compat++ build-depends: base >= 4.9 && < 4.18 , deepseq >= 1.3 && < 1.5+ -- Required so that GHC.IntWord64 is available on 32 bit systems+ , ghc-prim , primitive >= 0.6.4.0 && < 0.8+ , hashable >= 1.2 && < 1.5 test-suite test default-language: Haskell2010@@ -57,7 +63,7 @@ build-depends: base , bytestring >= 0.10 , ghc-prim- , hedgehog == 1.0.*+ , hedgehog >= 1.0 && < 1.2 , primitive , wide-word @@ -70,8 +76,8 @@ hs-source-dirs: test build-depends: base- , QuickCheck >= 2.9.2 && < 2.14+ , QuickCheck >= 2.9.2 && < 2.15 , quickcheck-classes >= 0.6.3 && < 0.7.0 , primitive- , semirings >= 0.2 && < 0.6+ , semirings >= 0.2 && < 0.8 , wide-word