largeword-1.0.5/000755 000765 000024 00000000000 12143661233 013426 5ustar00domstaff000000 000000 largeword-1.0.5/Data/000755 000765 000024 00000000000 12143661233 014277 5ustar00domstaff000000 000000 largeword-1.0.5/largeword.cabal000644 000765 000024 00000002624 12143661233 016404 0ustar00domstaff000000 000000 name: largeword version: 1.0.5 license: BSD3 copyright: Dominic Steinitz author: Dominic Steinitz maintainer: Dominic Steinitz description: Provides Word128, Word192 and Word256 and a way of producing other large words if required. synopsis: Provides Word128, Word192 and Word256 and a way of producing other large words if required. homepage: https://github.com/idontgetoutmuch/largeword category: Data stability: stable build-type: Simple cabal-version: >= 1.9.2 tested-with: GHC == 7.0.3, GHC == 7.6.2 -- Tests/Properties.hs shouldn't have to go here, but the source files -- for the test-suite stanzas don't get picked up by `cabal sdist`. Extra-source-files: Tests/Properties.hs source-repository head type: git location: https://github.com/idontgetoutmuch/largeword Library Build-Depends: base >= 4.0 && < 5 exposed-modules: Data.LargeWord Test-suite tests Type: exitcode-stdio-1.0 Hs-source-dirs: Tests Main-is: Properties.hs Build-depends: base >= 4.0 && < 5, test-framework >= 0.3.3 && < 0.9, test-framework-quickcheck2 >= 0.2.9 && < 0.4, test-framework-hunit >= 0.2.6 && < 0.4, QuickCheck >= 2.4.0.1, HUnit >= 1.2.2.3, largeword == 1.0.5 largeword-1.0.5/Setup.hs000644 000765 000024 00000000117 12143661233 015061 0ustar00domstaff000000 000000 module Main where import Distribution.Simple main :: IO () main = defaultMain largeword-1.0.5/Tests/000755 000765 000024 00000000000 12143661233 014530 5ustar00domstaff000000 000000 largeword-1.0.5/Tests/Properties.hs000644 000765 000024 00000001431 12143661233 017217 0ustar00domstaff000000 000000 module Main (main) where import Test.HUnit hiding (Test) import Test.QuickCheck hiding ((.&.)) import Test.Framework (Test, defaultMain, testGroup) import Test.Framework.Providers.QuickCheck2 (testProperty) import Test.Framework.Providers.HUnit import Data.LargeWord import Data.Bits import Control.Monad 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 = shiftR (18446744073709551616 :: Word128) 64 @?= 1 tests :: [Test] tests = [ testProperty "largeword shift left then right" pShiftRightShiftLeft , testCase "largeword shift 2^64 by 2^64" u1 ] main = defaultMain tests largeword-1.0.5/Data/LargeWord.hs000644 000765 000024 00000017111 12143661233 016522 0ustar00domstaff000000 000000 {-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module : Data.LargeWord -- Copyright : (c) Dominic Steinitz 2004 - 2011 -- License : BSD -- -- Maintainer : dominic@steinitz.org -- Stability : experimental -- Portability : portable -- -- Provides Word128, Word192 and Word256 and a way of producing other -- large words if required. -- ----------------------------------------------------------------------------- module Data.LargeWord ( LargeKey(..) , Word96 , Word128 , Word160 , Word192 , Word224 , Word256 , loHalf , hiHalf ) where import Data.Word import Data.Bits import Numeric import Data.Char -- 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 -- 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 -- 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 -- 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 -- 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 -- Define larger keys from smaller ones. data LargeKey a b = LargeKey a b deriving (Eq, Ord) {-# INLINE loHalf #-} loHalf (LargeKey a b) = a {-# INLINE hiHalf #-} hiHalf (LargeKey a b) = b instance (Ord a, Bits a, Num a, LargeWord a, Bits b, Num b, LargeWord b) => LargeWord (LargeKey a b) where largeWordToInteger (LargeKey lo hi) = largeWordToInteger lo + (2^(bitSize lo)) * largeWordToInteger hi integerToLargeWord x = let (h,l) = x `quotRem` (2^(bitSize lo)) (lo,hi) = (integerToLargeWord l, integerToLargeWord h) in LargeKey lo hi largeWordPlus (LargeKey alo ahi) (LargeKey blo bhi) = LargeKey lo' hi' where lo' = alo + blo hi' = ahi + bhi + if lo' < alo then 1 else 0 largeWordMinus (LargeKey alo ahi) (LargeKey blo bhi) = LargeKey lo' hi' where lo' = alo - blo hi' = ahi - bhi - if lo' > alo then 1 else 0 largeWordAnd (LargeKey alo ahi) (LargeKey blo bhi) = LargeKey lo' hi' where lo' = alo .&. blo hi' = ahi .&. bhi largeWordOr (LargeKey alo ahi) (LargeKey blo bhi) = LargeKey lo' hi' where lo' = alo .|. blo hi' = ahi .|. bhi largeWordXor (LargeKey alo ahi) (LargeKey blo bhi) = LargeKey lo' hi' where lo' = alo `xor` blo hi' = ahi `xor` bhi 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 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 b, Ord a, Bits a, Num a, LargeWord a, Bits 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 | testBit b i = go (i+1) (r + (a `shiftL` i)) | otherwise = go (i+1) r negate = id abs = id signum a = if a > 0 then 1 else 0 fromInteger = integerToLargeWord -- 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) => Bits (LargeKey a b) where (.&.) = largeWordAnd (.|.) = largeWordOr xor = largeWordXor shift = largeWordShift x `rotate` i | i < 0 = (x `largeWordShift` i) .|. (x `largeWordShift` (i + largeBitSize x)) | i == 0 = x | i > 0 = (x `largeWordShift` i) .|. (x `largeWordShift` (i - largeBitSize x)) complement (LargeKey a b) = LargeKey (complement a) (complement b) bitSize = largeBitSize isSigned _ = False #if MIN_VERSION_base(4,6,0) bit = bitDefault testBit = testBitDefault popCount = popCountDefault #endif instance (Ord a, Bits a, Bounded a, Integral a, LargeWord a, Bits b, Bounded b, Integral b, LargeWord b) => Bounded (LargeKey a b) where minBound = 0 maxBound = result where result = fromIntegral $ (1 + fromIntegral (maxBound `asTypeOf` (boflk result)))* (1 + fromIntegral (maxBound `asTypeOf` (aoflk result))) - 1 aoflk :: (LargeKey a b) -> a aoflk = undefined 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) => Integral (LargeKey a b) where toInteger = largeWordToInteger quotRem a b = let r = a - q*b q = go 0 (bitSize a) 0 in (q,r) where -- Trivial long division go t 0 v = if v >= b then t+1 else t go t i v | v >= b = go (setBit t i) i' v2 | otherwise = go t i' v1 where i' = i - 1 newBit = if (testBit a i') then 1 else 0 v1 = (v `shiftL` 1) .|. newBit 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 toRational w = toRational (fromIntegral w :: Integer) instance (Eq a, Bounded a, Num a, Enum b, Enum a, Bounded b, Num b) => Enum (LargeKey a b) where toEnum i = LargeKey (toEnum i) 0 fromEnum (LargeKey l _) = fromEnum l pred (LargeKey 0 h) = LargeKey maxBound (pred h) pred (LargeKey l h) = LargeKey (pred l) h succ (LargeKey l h) = if l == maxBound then LargeKey 0 (succ h) else LargeKey (succ l) h type Word96 = LargeKey Word32 Word64 type Word128 = LargeKey Word64 Word64 type Word160 = LargeKey Word32 Word128 type Word192 = LargeKey Word64 Word128 type Word224 = LargeKey Word32 Word192 type Word256 = LargeKey Word64 Word192