wide-word 0.1.0.7 → 0.1.0.8
raw patch · 5 files changed
+296/−39 lines, 5 filesdep +QuickCheckdep +primitivedep +quickcheck-classes
Dependencies added: QuickCheck, primitive, quickcheck-classes, semirings
Files
- ChangeLog.md +7/−0
- src/Data/WideWord/Int128.hs +105/−15
- src/Data/WideWord/Word128.hs +107/−22
- test/laws.hs +61/−0
- wide-word.cabal +16/−2
ChangeLog.md view
@@ -1,5 +1,12 @@ # Revision history for wide-word +## 0.1.0.8 -- 2019-01-31++* Improve implementation of succ/pred.+* Add tests for typeclass laws.+* Add Prim instances for Int128 and Word128.+* Fix/re-instate rewite rules.+ ## 0.1.0.7 -- 2018-11-16 * Switch to Hedgehog for testing.
src/Data/WideWord/Int128.hs view
@@ -44,22 +44,22 @@ import GHC.Base (Int (..), and#, int2Word#, minusWord#, not#, or#, plusWord#, plusWord2# , subWordC#, timesWord#, timesWord2#, word2Int#, xor#) import GHC.Enum (predError, succError)+import GHC.Exts ((+#), (*#), State#, Int#, Addr#, ByteArray#, MutableByteArray#) import GHC.Int (Int64 (..)) import GHC.Real ((%))-import GHC.Word (Word64 (..), byteSwap64)+import GHC.Word (Word64 (..), Word32, byteSwap64) +import Data.Primitive.Types (Prim (..), defaultSetByteArray#, defaultSetOffAddr#) data Int128 = Int128 { int128Hi64 :: {-# UNPACK #-} !Word64 , int128Lo64 :: {-# UNPACK #-} !Word64 }- deriving Eq-+ deriving (Eq) byteSwapInt128 :: Int128 -> Int128 byteSwapInt128 (Int128 a1 a0) = Int128 (byteSwap64 a0) (byteSwap64 a1) - showHexInt128 :: Int128 -> String showHexInt128 (Int128 a1 a0) | a1 == 0 = showHex a0 ""@@ -145,6 +145,28 @@ instance NFData Int128 where rnf (Int128 a1 a0) = rnf a1 `seq` rnf a0 +instance Prim Int128 where+ sizeOf# = sizeOf128#+ alignment# = alignment128#+ indexByteArray# = indexByteArray128#+ readByteArray# = readByteArray128#+ writeByteArray# = writeByteArray128#+ setByteArray# = setByteArray128#+ indexOffAddr# = indexOffAddr128#+ readOffAddr# = readOffAddr128#+ writeOffAddr# = writeOffAddr128#+ setOffAddr# = setOffAddr128#+ {-# INLINE sizeOf# #-}+ {-# INLINE alignment# #-}+ {-# INLINE indexByteArray# #-}+ {-# INLINE readByteArray# #-}+ {-# INLINE writeByteArray# #-}+ {-# INLINE setByteArray# #-}+ {-# INLINE indexOffAddr# #-}+ {-# INLINE readOffAddr# #-}+ {-# INLINE writeOffAddr# #-}+ {-# INLINE setOffAddr# #-}+ -- ----------------------------------------------------------------------------- -- Rewrite rules. @@ -152,6 +174,10 @@ "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 :: Word64 -> Int128" fromIntegral = Int128 0 #-} -- -----------------------------------------------------------------------------@@ -172,20 +198,20 @@ succ128 :: Int128 -> Int128 succ128 (Int128 a1 a0)- | a1 == 0x7fffffffffffffff && a0 == maxBound = succError "Int128"- | otherwise =- case a0 + 1 of- 0 -> Int128 (a1 + 1) 0- s -> Int128 a1 s+ | a0 == maxBound = if a1 == 0x7fffffffffffffff+ then succError "Int128"+ else Int128 (a1 + 1) 0+ | otherwise = Int128 a1 (a0 + 1) + pred128 :: Int128 -> Int128 pred128 (Int128 a1 a0)- | a1 == 0x8000000000000000 && a0 == 0 = predError "Int128"- | otherwise =- case a0 of- 0 -> Int128 (a1 - 1) maxBound- _ -> Int128 a1 (a0 - 1)+ | a0 == 0 = if a1 == 0x8000000000000000+ then predError "Int128"+ else Int128 (a1 - 1) maxBound+ | otherwise = Int128 a1 (a0 - 1) + {-# INLINABLE toEnum128 #-} toEnum128 :: Int -> Int128 toEnum128 i = Int128 0 (toEnum i)@@ -395,7 +421,7 @@ Int128 n1 n0 -> negate (fromIntegral n1 `shiftL` 64 + fromIntegral n0) -- -------------------------------------------------------------------------------- Functions for `Integral` instance.+-- Functions for `Storable` instance. peek128 :: Ptr Int128 -> IO Int128 peek128 ptr =@@ -431,6 +457,67 @@ word128ToInt128 (Word128 a1 a0) = Int128 a1 a0 -- -----------------------------------------------------------------------------+-- Functions for `Prim` instance.++{-# INLINE sizeOf128# #-}+sizeOf128# :: Int128 -> Int#+sizeOf128# _ = 2# *# sizeOf# (undefined :: Word64)++{-# INLINE alignment128# #-}+alignment128# :: Int128 -> Int#+alignment128# _ = 2# *# alignment# (undefined :: Word64)++{-# INLINE indexByteArray128# #-}+indexByteArray128# :: ByteArray# -> Int# -> Int128+indexByteArray128# arr# i# =+ let x = indexByteArray# arr# (2# *# (unInt index1))+ y = indexByteArray# arr# (2# *# i# +# (unInt index0))+ in Int128 x y++{-# INLINE readByteArray128# #-}+readByteArray128# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Int128 #)+readByteArray128# arr# i# =+ \s0 -> case readByteArray# arr# (2# *# (unInt index1)) s0 of+ (# s1, x #) -> case readByteArray# arr# (2# *# i# +# (unInt index0)) s1 of+ (# s2, y #) -> (# s2, Int128 x y #)++{-# INLINE writeByteArray128# #-}+writeByteArray128# :: MutableByteArray# s -> Int# -> Int128 -> State# s -> State# s+writeByteArray128# arr# i# (Int128 a b) =+ \s0 -> case writeByteArray# arr# (2# *# i# +# (unInt index1)) a s0 of+ s1 -> case writeByteArray# arr# (2# *# i# +# (unInt index0)) b s1 of+ s2 -> s2++{-# INLINE setByteArray128# #-}+setByteArray128# :: MutableByteArray# s -> Int# -> Int# -> Int128 -> State# s -> State# s+setByteArray128# = defaultSetByteArray#++{-# INLINE indexOffAddr128# #-}+indexOffAddr128# :: Addr# -> Int# -> Int128+indexOffAddr128# addr# i# =+ let x = indexOffAddr# addr# (2# *# i# +# (unInt index1))+ y = indexOffAddr# addr# (2# *# i# +# (unInt index0))+ in Int128 x y++{-# INLINE readOffAddr128# #-}+readOffAddr128# :: Addr# -> Int# -> State# s -> (# State# s, Int128 #)+readOffAddr128# addr# i# =+ \s0 -> case readOffAddr# addr# (2# *# i# +# (unInt index1)) s0 of+ (# s1, x #) -> case readOffAddr# addr# (2# *# i# +# (unInt index0)) s1 of+ (# s2, y #) -> (# s2, Int128 x y #)++{-# INLINE writeOffAddr128# #-}+writeOffAddr128# :: Addr# -> Int# -> Int128 -> State# s -> State# s+writeOffAddr128# addr# i# (Int128 a b) =+ \s0 -> case writeOffAddr# addr# (2# *# i# +# (unInt index1)) a s0 of+ s1 -> case writeOffAddr# addr# (2# *# i# +# (unInt index0)) b s1 of+ s2 -> s2++{-# INLINE setOffAddr128# #-}+setOffAddr128# :: Addr# -> Int# -> Int# -> Int128 -> State# s -> State# s+setOffAddr128# = defaultSetOffAddr#++-- ----------------------------------------------------------------------------- -- Constants. zeroInt128 :: Int128@@ -441,6 +528,9 @@ minusOneInt128 :: Int128 minusOneInt128 = Int128 maxBound maxBound++unInt :: Int -> Int#+unInt (I# i#) = i# index0, index1 :: Int #if WORDS_BIGENDIAN
src/Data/WideWord/Word128.hs view
@@ -39,23 +39,24 @@ import GHC.Base (Int (..), and#, int2Word#, minusWord#, not#, or#, plusWord#, plusWord2# , quotRemWord2#, subWordC#, timesWord#, timesWord2#, xor#) import GHC.Enum (predError, succError)+import GHC.Exts ((*#), (+#), Int#, State#, ByteArray#, MutableByteArray#, Addr#) import GHC.Real ((%), divZeroError)-import GHC.Word (Word64 (..), byteSwap64)+import GHC.Word (Word64 (..), Word32, byteSwap64) + import Numeric (showHex) +import Data.Primitive.Types (Prim (..), defaultSetByteArray#, defaultSetOffAddr#) data Word128 = Word128 { word128Hi64 :: {-# UNPACK #-} !Word64 , word128Lo64 :: {-# UNPACK #-} !Word64 }- deriving Eq-+ deriving (Eq) byteSwapWord128 :: Word128 -> Word128 byteSwapWord128 (Word128 a1 a0) = Word128 (byteSwap64 a0) (byteSwap64 a1) - showHexWord128 :: Word128 -> String showHexWord128 (Word128 a1 a0) | a1 == 0 = showHex a0 ""@@ -141,22 +142,42 @@ instance NFData Word128 where rnf (Word128 a1 a0) = rnf a1 `seq` rnf a0 +instance Prim Word128 where+ sizeOf# = sizeOf128#+ alignment# = alignment128#+ indexByteArray# = indexByteArray128#+ readByteArray# = readByteArray128#+ writeByteArray# = writeByteArray128#+ setByteArray# = setByteArray128#+ indexOffAddr# = indexOffAddr128#+ readOffAddr# = readOffAddr128#+ writeOffAddr# = writeOffAddr128#+ setOffAddr# = setOffAddr128#+ {-# INLINE sizeOf# #-}+ {-# INLINE alignment# #-}+ {-# INLINE indexByteArray# #-}+ {-# INLINE readByteArray# #-}+ {-# INLINE writeByteArray# #-}+ {-# INLINE setByteArray# #-}+ {-# INLINE indexOffAddr# #-}+ {-# INLINE readOffAddr# #-}+ {-# INLINE writeOffAddr# #-}+ {-# INLINE setOffAddr# #-}+ -- ----------------------------------------------------------------------------- -- Rewrite rules. {-# RULES "fromIntegral :: Word128 -> Word128" fromIntegral = id :: Word128 -> Word128- #-} -{-# RULES "fromIntegral :: Int -> Word128" fromIntegral = \(I# i#) -> Word128 (W64# 0##) (W64# (int2Word# i#))-"fromIntegral :: Word- > Word128" fromIntegral = Word128 0 . fromIntegral-"fromIntegral :: Word32 -> Word128" fromIntegral = Word128 0 . fromIntegral+"fromIntegral :: Word -> Word128" fromIntegral = Word128 0 . (fromIntegral :: Word -> Word64)+"fromIntegral :: Word32 -> Word128" fromIntegral = Word128 0 . (fromIntegral :: Word32 -> Word64) "fromIntegral :: Word64 -> Word128" fromIntegral = Word128 0 -"fromIntegral :: Word128 -> Int" fromIntegral = \(Word128 _ w) -> fromIntegral w-"fromIntegral :: Word128 -> Word" fromIntegral = \(Word128 _ w) -> fromIntegral w-"fromIntegral :: Word128 -> Word32" fromIntegral = \(Word128 _ w) -> fromIntegral w+"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 -> Word64" fromIntegral = \(Word128 _ w) -> w #-} @@ -175,20 +196,20 @@ succ128 :: Word128 -> Word128 succ128 (Word128 a1 a0)- | a1 == maxBound && a0 == maxBound = succError "Word128"- | otherwise =- case a0 + 1 of- 0 -> Word128 (a1 + 1) 0- s -> Word128 a1 s+ | a0 == maxBound = if a1 == maxBound+ then succError "Word128"+ else Word128 (a1 + 1) 0+ | otherwise = Word128 a1 (a0 + 1) + pred128 :: Word128 -> Word128 pred128 (Word128 a1 a0)- | a1 == 0 && a0 == 0 = predError "Word128"- | otherwise =- case a0 of- 0 -> Word128 (a1 - 1) maxBound- _ -> Word128 a1 (a0 - 1)+ | a0 == 0 = if a1 == 0+ then predError "Word128"+ else Word128 (a1 - 1) maxBound+ | otherwise = Word128 a1 (a0 - 1) + {-# INLINABLE toEnum128 #-} toEnum128 :: Int -> Word128 toEnum128 i = Word128 0 (toEnum i)@@ -414,7 +435,7 @@ toInteger128 (Word128 a1 a0) = fromIntegral a1 `shiftL` 64 + fromIntegral a0 -- -------------------------------------------------------------------------------- Functions for `Integral` instance.+-- Functions for `Storable` instance. peek128 :: Ptr Word128 -> IO Word128 peek128 ptr =@@ -435,6 +456,67 @@ pokeElemOff (castPtr ptr) (2 * idx + index1) a1 -- -----------------------------------------------------------------------------+-- Functions for `Prim` instance.++{-# INLINE sizeOf128# #-}+sizeOf128# :: Word128 -> Int#+sizeOf128# _ = 2# *# sizeOf# (undefined :: Word64)++{-# INLINE alignment128# #-}+alignment128# :: Word128 -> Int#+alignment128# _ = 2# *# alignment# (undefined :: Word64)++{-# INLINE indexByteArray128# #-}+indexByteArray128# :: ByteArray# -> Int# -> Word128+indexByteArray128# arr# i# =+ let x = indexByteArray# arr# (2# *# i# +# (unInt index1))+ y = indexByteArray# arr# (2# *# i# +# (unInt index0))+ in Word128 x y++{-# INLINE readByteArray128# #-}+readByteArray128# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Word128 #)+readByteArray128# arr# i# =+ \s0 -> case readByteArray# arr# (2# *# i# +# (unInt index1)) s0 of+ (# s1, x #) -> case readByteArray# arr# (2# *# i# +# (unInt index0)) s1 of+ (# s2, y #) -> (# s2, Word128 x y #)++{-# INLINE writeByteArray128# #-}+writeByteArray128# :: MutableByteArray# s -> Int# -> Word128 -> State# s -> State# s+writeByteArray128# arr# i# (Word128 a b) =+ \s0 -> case writeByteArray# arr# (2# *# i# +# (unInt index1)) a s0 of+ s1 -> case writeByteArray# arr# (2# *# i# +# (unInt index0)) b s1 of+ s2 -> s2++{-# INLINE setByteArray128# #-}+setByteArray128# :: MutableByteArray# s -> Int# -> Int# -> Word128 -> State# s -> State# s+setByteArray128# = defaultSetByteArray#++{-# INLINE indexOffAddr128# #-}+indexOffAddr128# :: Addr# -> Int# -> Word128+indexOffAddr128# addr# i# =+ let x = indexOffAddr# addr# (2# *# i# +# (unInt index1))+ y = indexOffAddr# addr# (2# *# i# +# (unInt index0))+ in Word128 x y++{-# INLINE readOffAddr128# #-}+readOffAddr128# :: Addr# -> Int# -> State# s -> (# State# s, Word128 #)+readOffAddr128# addr# i# =+ \s0 -> case readOffAddr# addr# (2# *# i# +# (unInt index1)) s0 of+ (# s1, x #) -> case readOffAddr# addr# (2# *# i# +# (unInt index0)) s1 of+ (# s2, y #) -> (# s2, Word128 x y #)++{-# INLINE writeOffAddr128# #-}+writeOffAddr128# :: Addr# -> Int# -> Word128 -> State# s -> State# s+writeOffAddr128# addr# i# (Word128 a b) =+ \s0 -> case writeOffAddr# addr# (2# *# i# +# (unInt index1)) a s0 of+ s1 -> case writeOffAddr# addr# (2# *# i# +# (unInt index0)) b s1 of+ s2 -> s2++{-# INLINE setOffAddr128# #-}+setOffAddr128# :: Addr# -> Int# -> Int# -> Word128 -> State# s -> State# s+setOffAddr128# = defaultSetOffAddr#++-- ----------------------------------------------------------------------------- -- Constants. zeroWord128 :: Word128@@ -442,6 +524,9 @@ oneWord128 :: Word128 oneWord128 = Word128 0 1++unInt :: Int -> Int#+unInt (I# i#) = i# -- Use these indices to get the peek/poke ordering endian correct. index0, index1 :: Int
+ test/laws.hs view
@@ -0,0 +1,61 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}++import Data.WideWord+import Test.QuickCheck.Arbitrary+import Test.QuickCheck.Classes+import Data.Semiring hiding ((+),(*))+import Data.Proxy (Proxy(Proxy))+import Data.Bits+import Foreign.Storable++main :: IO ()+main = lawsCheckMany allPropsApplied++allPropsApplied :: [(String, [Laws])]+allPropsApplied =+ [ ("Int128", allLaws (Proxy :: Proxy Int128))+ , ("Word128", allLaws (Proxy :: Proxy Word128))+ ] ++allLaws ::+ ( Arbitrary a+ , Bounded a+ , Enum a+ , Eq a+ , Integral a+ , Ord a+ , Read a+ , Show a+ , Storable a+ , Bits a+ , FiniteBits a+ , Semiring a+ ) => Proxy a -> [Laws]+allLaws p = map ($ p)+ [ bitsLaws+ , boundedEnumLaws+ , eqLaws+ , integralLaws+ , ordLaws+ , semiringLaws+ , storableLaws+ ]++instance Arbitrary Word128 where+ arbitrary = Word128 <$> arbitrary <*> arbitrary++instance Arbitrary Int128 where+ arbitrary = Int128 <$> arbitrary <*> arbitrary++-- These are used to make sure that 'Num' behaves properly.+instance Semiring Word128 where+ zero = 0+ one = 1+ plus = (+)+ times = (*)++instance Semiring Int128 where+ zero = 0+ one = 1+ plus = (+)+ times = (*)
wide-word.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: wide-word-version: 0.1.0.7+version: 0.1.0.8 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@@ -37,7 +37,7 @@ build-depends: base >= 4.8 && < 5.0 , deepseq >= 1.3 && < 1.5- , ghc-prim+ , primitive >= 0.6.4.0 && < 0.7.0.0 test-suite test default-language: Haskell2010@@ -55,4 +55,18 @@ , bytestring >= 0.10 , ghc-prim , hedgehog == 0.6.*+ , wide-word++test-suite laws+ default-language: Haskell2010+ ghc-options: -Wall+ type: exitcode-stdio-1.0++ main-is: laws.hs+ hs-source-dirs: test++ build-depends: base >= 4.8 && < 5.0+ , QuickCheck >= 2.9.2 && < 2.13+ , quickcheck-classes >= 0.4.0 && < 0.7.0+ , semirings >= 0.2 && < 0.3 , wide-word