largeword 1.1.1 → 1.2.0
raw patch · 3 files changed
+172/−64 lines, 3 files
Files
- Data/LargeWord.hs +91/−61
- Tests/Properties.hs +80/−2
- largeword.cabal +1/−1
Data/LargeWord.hs view
@@ -1,8 +1,16 @@-{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -Wall #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-type-defaults #-}+{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}+{-# OPTIONS_GHC -fno-warn-missing-methods #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++{-# LANGUAGE CPP #-}+ ----------------------------------------------------------------------------- -- | -- Module : Data.LargeWord--- Copyright : (c) Dominic Steinitz 2004 - 2011+-- Copyright : (c) Dominic Steinitz 2004 - 2014 -- License : BSD -- -- Maintainer : dominic@steinitz.org@@ -29,75 +37,75 @@ import Data.Word import Data.Bits import Numeric-import Data.Char import Control.Applicative ((<$>), (<*>)) import Data.Binary (Binary, put, get) + -- Keys have certain capabilities. class LargeWord a where largeWordToInteger :: a -> Integer integerToLargeWord :: Integer -> a- largeWordPlus :: a -> a -> a- largeWordMinus :: a -> a -> a- largeWordAnd :: a -> a -> a- largeWordOr :: a -> a -> a- largeWordShift :: a -> Int -> a- largeWordXor :: a -> a -> a- largeBitSize :: a -> Int+ largeWordPlus :: a -> a -> a+ largeWordMinus :: a -> a -> a+ largeWordAnd :: a -> a -> a+ largeWordOr :: a -> a -> a+ largeWordShift :: a -> Int -> a+ largeWordXor :: a -> a -> a+ largeBitSize :: a -> Int -- Word8 is a key in the obvious way instance LargeWord Word8 where largeWordToInteger = toInteger integerToLargeWord = fromInteger- largeWordPlus = (+)- largeWordMinus = (-)- largeWordAnd = (.&.)- largeWordOr = (.|.)- largeWordShift = shift- largeWordXor = xor- largeBitSize = bitSize+ largeWordPlus = (+)+ largeWordMinus = (-)+ largeWordAnd = (.&.)+ largeWordOr = (.|.)+ largeWordShift = shift+ largeWordXor = xor+ largeBitSize = finiteBitSize -- Word16 is a key in the obvious way instance LargeWord Word16 where largeWordToInteger = toInteger integerToLargeWord = fromInteger- largeWordPlus = (+)- largeWordMinus = (-)- largeWordAnd = (.&.)- largeWordOr = (.|.)- largeWordShift = shift- largeWordXor = xor- largeBitSize = bitSize+ largeWordPlus = (+)+ largeWordMinus = (-)+ largeWordAnd = (.&.)+ largeWordOr = (.|.)+ largeWordShift = shift+ largeWordXor = xor+ largeBitSize = finiteBitSize -- Word32 is a key in the obvious way. instance LargeWord Word32 where largeWordToInteger = toInteger integerToLargeWord = fromInteger- largeWordPlus = (+)- largeWordMinus = (-)- largeWordAnd = (.&.)- largeWordOr = (.|.)- largeWordShift = shift- largeWordXor = xor- largeBitSize = bitSize+ largeWordPlus = (+)+ largeWordMinus = (-)+ largeWordAnd = (.&.)+ largeWordOr = (.|.)+ largeWordShift = shift+ largeWordXor = xor+ largeBitSize = finiteBitSize -- Word64 is a key in the obvious way. instance LargeWord Word64 where largeWordToInteger = toInteger integerToLargeWord = fromInteger- largeWordPlus = (+)- largeWordMinus = (-)- largeWordAnd = (.&.)- largeWordOr = (.|.)- largeWordShift = shift- largeWordXor = xor- largeBitSize = bitSize+ largeWordPlus = (+)+ largeWordMinus = (-)+ largeWordAnd = (.&.)+ largeWordOr = (.|.)+ largeWordShift = shift+ largeWordXor = xor+ largeBitSize = finiteBitSize -- Define larger keys from smaller ones. @@ -105,16 +113,18 @@ deriving (Eq, Ord) {-# INLINE loHalf #-}-loHalf (LargeKey a b) = a+loHalf :: LargeKey a b -> a+loHalf (LargeKey a _b) = a {-# INLINE hiHalf #-}-hiHalf (LargeKey a b) = b+hiHalf :: LargeKey a b -> b+hiHalf (LargeKey _a b) = b -instance (Ord a, Bits a, Num a, LargeWord a, Bits b, Num b, LargeWord b) =>+instance (Ord a, Bits a, FiniteBits a, Num a, LargeWord a, Bits b, FiniteBits b, Num b, LargeWord b) => LargeWord (LargeKey a b) where largeWordToInteger (LargeKey lo hi) =- largeWordToInteger lo + (2^(bitSize lo)) * largeWordToInteger hi+ largeWordToInteger lo + (2^(finiteBitSize lo)) * largeWordToInteger hi integerToLargeWord x =- let (h,l) = x `quotRem` (2^(bitSize lo))+ let (h,l) = x `quotRem` (2^(finiteBitSize lo)) (lo,hi) = (integerToLargeWord l, integerToLargeWord h) in LargeKey lo hi largeWordPlus (LargeKey alo ahi) (LargeKey blo bhi) =@@ -140,27 +150,40 @@ largeWordShift w 0 = w largeWordShift (LargeKey lo hi) x = if x >= 0- then- LargeKey (shift lo x)- (shift hi x .|. (convab $ shift lo (x - (bitSize lo))))- else- LargeKey (shift lo x .|. (convba $ shift hi (x + (bitSize hi))))- (shift hi x)- where convab = integerToLargeWord . largeWordToInteger- convba = integerToLargeWord . largeWordToInteger+ then+ if loSize <= hiSize+ then+ LargeKey (shift lo x)+ (shift hi x .|. (shift (convab lo) (x - (finiteBitSize lo))))+ else+ LargeKey (shift lo x)+ (shift hi x .|. (convab (shift lo (x - (finiteBitSize lo)))))+ else+ if loSize <= hiSize+ then+ LargeKey (shift lo x .|. (convba (shift hi (x + (finiteBitSize lo)))))+ (shift hi x)+ else+ LargeKey (shift lo x .|. (shift (convba hi) (x + (finiteBitSize lo))))+ (shift hi x)+ where+ loSize = finiteBitSize lo+ hiSize = finiteBitSize hi+ convab = integerToLargeWord . largeWordToInteger+ convba = integerToLargeWord . largeWordToInteger largeBitSize ~(LargeKey lo hi) = largeBitSize lo + largeBitSize hi -instance (Ord a, Bits a, Num a, LargeWord a, Bits b, Num b, LargeWord b) => Show (LargeKey a b) where- showsPrec p = showInt . largeWordToInteger+instance (Ord a, Bits a, FiniteBits a, Num a, LargeWord a, Bits b, FiniteBits b, Num b, LargeWord b) => Show (LargeKey a b) where+ showsPrec _p = showInt . largeWordToInteger -instance (Ord b, Ord a, Bits a, Num a, LargeWord a, Bits b, Num b, LargeWord b) =>+instance (Ord b, Ord a, Bits a, FiniteBits a, Num a, LargeWord a, Bits b, FiniteBits b, Num b, LargeWord b) => Num (LargeKey a b) where (+) = largeWordPlus (-) = largeWordMinus (*) a b = go 0 0 where go i r- | i == bitSize r = r+ | i == finiteBitSize r = r | testBit b i = go (i+1) (r + (a `shiftL` i)) | otherwise = go (i+1) r negate = id@@ -170,7 +193,7 @@ -- Larger keys are instances of Bits provided their constituents are keys. -instance (Ord a, Ord b, Bits a, Num a, LargeWord a, Bits b, Num b, LargeWord b) =>+instance (Ord a, Ord b, Bits a, FiniteBits a, Num a, LargeWord a, Bits b, FiniteBits b, Num b, LargeWord b) => Bits (LargeKey a b) where (.&.) = largeWordAnd (.|.) = largeWordOr@@ -181,8 +204,11 @@ | i == 0 = x | i > 0 = (x `largeWordShift` i) .|. (x `largeWordShift` (i - largeBitSize x))+ | otherwise = error $ "Clearly i must be < 0, == 0 or > 0" +++ "but ghc can't determine this" complement (LargeKey a b) = LargeKey (complement a) (complement b) bitSize = largeBitSize+ bitSizeMaybe = Just . largeBitSize isSigned _ = False #if MIN_VERSION_base(4,6,0) bit = bitDefault@@ -190,8 +216,12 @@ popCount = popCountDefault #endif -instance (Ord a, Bits a, Bounded a, Integral a, LargeWord a,- Bits b, Bounded b, Integral b, LargeWord b) =>+instance (LargeWord a, FiniteBits a, Ord a, Num a,+ LargeWord b, FiniteBits b, Ord b, Num b) => FiniteBits (LargeKey a b) where+ finiteBitSize = largeBitSize++instance (Ord a, Bits a, FiniteBits a, Bounded a, Integral a, LargeWord a,+ Bits b, FiniteBits b, Bounded b, Integral b, LargeWord b) => Bounded (LargeKey a b) where minBound = 0 maxBound =@@ -206,12 +236,12 @@ boflk :: (LargeKey a b) -> b boflk = undefined -instance (Bounded a, Bounded b, Enum b, Enum a, Ord a, Bits a, Num a, LargeWord a, Ord b, Bits b, Num b, LargeWord b) =>+instance (Bounded a, Bounded b, Enum b, Enum a, Ord a, Bits a, FiniteBits a, Num a, LargeWord a, Ord b, Bits b, FiniteBits b, Num b, LargeWord b) => Integral (LargeKey a b) where toInteger = largeWordToInteger quotRem a b = let r = a - q*b- q = go 0 (bitSize a) 0+ q = go 0 (finiteBitSize a) 0 in (q,r) where -- Trivial long division@@ -225,7 +255,7 @@ v2 = ((v - b) `shiftL` 1) .|. newBit divMod = quotRem -instance (Ord a, Bits a, Num a, Bounded a, Bounded b, Enum a, Enum b, LargeWord a, Ord b, Bits b, Num b, LargeWord b) => Real (LargeKey a b) where+instance (Ord a, Bits a, FiniteBits a, Num a, Bounded a, Bounded b, Enum a, Enum b, LargeWord a, Ord b, Bits b, FiniteBits b, Num b, LargeWord b) => Real (LargeKey a b) where toRational w = toRational (fromIntegral w :: Integer)
Tests/Properties.hs view
@@ -1,8 +1,15 @@+{-# OPTIONS_GHC -Wall #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-type-defaults #-}+{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}+{-# OPTIONS_GHC -fno-warn-missing-methods #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+ module Main (main) where import Test.HUnit hiding (Test) import Test.QuickCheck hiding ((.&.))-import Test.Framework (Test, defaultMain, testGroup)+import Test.Framework ( Test, defaultMain ) import Test.Framework.Providers.QuickCheck2 (testProperty) import Test.Framework.Providers.HUnit import Data.LargeWord@@ -11,29 +18,99 @@ import Data.Binary (encode, decode, Binary) import qualified Data.ByteString.Lazy as LZ +import Text.Printf+import Data.Word++ instance (Arbitrary a, Arbitrary b) => Arbitrary (LargeKey a b) where arbitrary = liftM2 LargeKey arbitrary arbitrary pShiftRightShiftLeft :: Word128 -> Bool pShiftRightShiftLeft x = shiftR (shiftL x 1) 1 == x .&. (fromInteger ((2^127) - 1)) +u1 :: Assertion u1 = shiftR (18446744073709551616 :: Word128) 64 @?= 1 +pQuotRem :: Word256 -> Bool+pQuotRem x = rx == fromInteger ry+ where+ (_qx, rx) = quotRem x 16+ (_qy, ry) = quotRem ((fromIntegral x) :: Integer) 16+ encodeDecode :: (Binary a, Binary b, Eq a, Eq b) => LargeKey a b -> Bool encodeDecode word = decode encoded == word where encoded = encode word {-# NOINLINE encoded #-} +correctEncoding :: Assertion correctEncoding = (decode . LZ.pack)- [0,0,0,0,0,0,0,0,50,89,125,125,237,119,73,240,217,12,178,101,235,8,44,221,50,122,244,125,115,181,239,78]+ [0,0,0,0,0,0,0,0,50,89,125,125,237,119,73,240+ ,217,12,178,101,235,8,44,221,50,122,244,125,115,181,239,78] @?= (1234567891234567891234567812345678123456781234567812345678 :: Word256) +pRotateLeftRight :: Word256 -> Bool+pRotateLeftRight x = rotate (rotate x 8) (-8) == x++pRepeatedShift :: Int -> Property+pRepeatedShift n =+ (n >= 0) ==> (((iterate (`shift` 8) (1::Word192))!!n) == shift (1::Word192) (n*8))++pRepeatedShift' :: Int -> Property+pRepeatedShift' n =+ (n >= 0) ==> (((iterate (`shift` 8) a)!!n) == shift a (n*8))++pRepeatedShift160 :: Int -> Property+pRepeatedShift160 n =+ (n >= 0) ==> (((iterate (`shift` 8) (1::Word160))!!n) == shift (1::Word160) (n*8))++u2 :: Assertion+u2 = (2 :: LargeKey Word256 Word128) ^ 254 @?=+ (fromInteger (2 :: Integer) ^ 254)++u3 :: Assertion+u3 = rotate (rotate ((2^255) :: Word256) (1)) (-1) @?=+ ((2^255) :: Word256)++a :: Word192+a = 0x0123456789ABCDEFFEDCBA98765432100011223344556677++u4 :: Assertion+u4 = shift (0x0123456789ABCDEFFEDCBA98765432100011223344556677 :: Word192) 80 @?=+ (0xBA9876543210001122334455667700000000000000000000 :: Word192)+++++x :: Word96+x = 0x112233445566778899AABBCC++y :: Word128+y = 0x112233445566778899AABBCCDDEEFF11++z :: Word160+z = 0x112233445566778899AABBCCDDEEFF1122334455++u5 :: Assertion+u5 = shift (0x112233445566778899AABBCC :: Word96) 40 @?=+ (0x66778899AABBCC0000000000 :: Word96)++u6 :: Assertion+u6 = rotate ((2^95) :: Word96) (1) @?= 1+ tests :: [Test] tests = [ testProperty "largeword shift left then right" pShiftRightShiftLeft+ , testProperty "largeword quotRem by 16" pQuotRem+ , testProperty "largeword rotate left then right" pRotateLeftRight+ , testProperty "largeword repeated shift vs single shift" pRepeatedShift , testCase "largeword shift 2^64 by 2^64" u1+ , testCase "largeword exponentiation 2^254" u2+ , testCase "largeword rotation by 1" u3+ , testCase "largeword shift by 80" u4+ , testCase "largeword shift by 40" u5+ , testCase "largeword rotate by 1" u6 , testCase "big-endian encoding" correctEncoding , testProperty "Word96 encode/decode loop" (encodeDecode::Word96 -> Bool) , testProperty "Word128 encode/decode loop" (encodeDecode::Word128 -> Bool)@@ -43,4 +120,5 @@ , testProperty "Word256 encode/decode loop" (encodeDecode::Word256 -> Bool) ] +main :: IO () main = defaultMain tests
largeword.cabal view
@@ -1,5 +1,5 @@ name: largeword-version: 1.1.1+version: 1.2.0 license: BSD3 copyright: Dominic Steinitz <dominic@steinitz.org> author: Dominic Steinitz <dominic@steinitz.org>