{-# 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
( LargeKey(..)
, Word96
, Word128
, Word160
, Word192
, Word224
, Word256
, loHalf
, hiHalf
) where
import Data.Word
import Data.Bits
import Numeric
import Control.Applicative ((<$>), (<*>))
import Data.Binary (Binary, put, get)
#if !(MIN_VERSION_base(4,7,0))
class FiniteBits a where
finiteBitSize :: a -> Int
instance FiniteBits Word8 where
finiteBitSize = bitSize
instance FiniteBits Word16 where
finiteBitSize = bitSize
instance FiniteBits Word32 where
finiteBitSize = bitSize
instance FiniteBits Word64 where
finiteBitSize = bitSize
#endif
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
instance LargeWord Word8 where
largeWordToInteger :: Word8 -> Integer
largeWordToInteger = Word8 -> Integer
forall a. Integral a => a -> Integer
toInteger
integerToLargeWord :: Integer -> Word8
integerToLargeWord = Integer -> Word8
forall a. Num a => Integer -> a
fromInteger
largeWordPlus :: Word8 -> Word8 -> Word8
largeWordPlus = Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
(+)
largeWordMinus :: Word8 -> Word8 -> Word8
largeWordMinus = (-)
largeWordAnd :: Word8 -> Word8 -> Word8
largeWordAnd = Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
(.&.)
largeWordOr :: Word8 -> Word8 -> Word8
largeWordOr = Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
(.|.)
largeWordShift :: Word8 -> Int -> Word8
largeWordShift = Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
shift
largeWordXor :: Word8 -> Word8 -> Word8
largeWordXor = Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
xor
largeBitSize :: Word8 -> Int
largeBitSize = Word8 -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize
instance LargeWord Word16 where
largeWordToInteger :: Word16 -> Integer
largeWordToInteger = Word16 -> Integer
forall a. Integral a => a -> Integer
toInteger
integerToLargeWord :: Integer -> Word16
integerToLargeWord = Integer -> Word16
forall a. Num a => Integer -> a
fromInteger
largeWordPlus :: Word16 -> Word16 -> Word16
largeWordPlus = Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
(+)
largeWordMinus :: Word16 -> Word16 -> Word16
largeWordMinus = (-)
largeWordAnd :: Word16 -> Word16 -> Word16
largeWordAnd = Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
(.&.)
largeWordOr :: Word16 -> Word16 -> Word16
largeWordOr = Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
(.|.)
largeWordShift :: Word16 -> Int -> Word16
largeWordShift = Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
shift
largeWordXor :: Word16 -> Word16 -> Word16
largeWordXor = Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
xor
largeBitSize :: Word16 -> Int
largeBitSize = Word16 -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize
instance LargeWord Word32 where
largeWordToInteger :: Word32 -> Integer
largeWordToInteger = Word32 -> Integer
forall a. Integral a => a -> Integer
toInteger
integerToLargeWord :: Integer -> Word32
integerToLargeWord = Integer -> Word32
forall a. Num a => Integer -> a
fromInteger
largeWordPlus :: Word32 -> Word32 -> Word32
largeWordPlus = Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
(+)
largeWordMinus :: Word32 -> Word32 -> Word32
largeWordMinus = (-)
largeWordAnd :: Word32 -> Word32 -> Word32
largeWordAnd = Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
(.&.)
largeWordOr :: Word32 -> Word32 -> Word32
largeWordOr = Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
(.|.)
largeWordShift :: Word32 -> Int -> Word32
largeWordShift = Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shift
largeWordXor :: Word32 -> Word32 -> Word32
largeWordXor = Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
xor
largeBitSize :: Word32 -> Int
largeBitSize = Word32 -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize
instance LargeWord Word64 where
largeWordToInteger :: Word64 -> Integer
largeWordToInteger = Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger
integerToLargeWord :: Integer -> Word64
integerToLargeWord = Integer -> Word64
forall a. Num a => Integer -> a
fromInteger
largeWordPlus :: Word64 -> Word64 -> Word64
largeWordPlus = Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
(+)
largeWordMinus :: Word64 -> Word64 -> Word64
largeWordMinus = (-)
largeWordAnd :: Word64 -> Word64 -> Word64
largeWordAnd = Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
(.&.)
largeWordOr :: Word64 -> Word64 -> Word64
largeWordOr = Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
(.|.)
largeWordShift :: Word64 -> Int -> Word64
largeWordShift = Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shift
largeWordXor :: Word64 -> Word64 -> Word64
largeWordXor = Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
xor
largeBitSize :: Word64 -> Int
largeBitSize = Word64 -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize
data LargeKey a b = LargeKey a b
deriving (LargeKey a b -> LargeKey a b -> Bool
(LargeKey a b -> LargeKey a b -> Bool)
-> (LargeKey a b -> LargeKey a b -> Bool) -> Eq (LargeKey a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => LargeKey a b -> LargeKey a b -> Bool
/= :: LargeKey a b -> LargeKey a b -> Bool
$c/= :: forall a b. (Eq a, Eq b) => LargeKey a b -> LargeKey a b -> Bool
== :: LargeKey a b -> LargeKey a b -> Bool
$c== :: forall a b. (Eq a, Eq b) => LargeKey a b -> LargeKey a b -> Bool
Eq)
{-# INLINE loHalf #-}
loHalf :: LargeKey a b -> a
loHalf :: LargeKey a b -> a
loHalf (LargeKey a
a b
_b) = a
a
{-# INLINE hiHalf #-}
hiHalf :: LargeKey a b -> b
hiHalf :: LargeKey a b -> b
hiHalf (LargeKey a
_a b
b) = b
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 a b -> Integer
largeWordToInteger (LargeKey a
lo b
hi) =
a -> Integer
forall a. LargeWord a => a -> Integer
largeWordToInteger a
lo Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ (Integer
2Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(a -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize a
lo)) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* b -> Integer
forall a. LargeWord a => a -> Integer
largeWordToInteger b
hi
integerToLargeWord :: Integer -> LargeKey a b
integerToLargeWord Integer
x =
let (Integer
h,Integer
l) = Integer
x Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
`quotRem` (Integer
2Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(a -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize a
lo))
(a
lo,b
hi) = (Integer -> a
forall a. LargeWord a => Integer -> a
integerToLargeWord Integer
l, Integer -> b
forall a. LargeWord a => Integer -> a
integerToLargeWord Integer
h) in
a -> b -> LargeKey a b
forall a b. a -> b -> LargeKey a b
LargeKey a
lo b
hi
largeWordPlus :: LargeKey a b -> LargeKey a b -> LargeKey a b
largeWordPlus (LargeKey a
alo b
ahi) (LargeKey a
blo b
bhi) =
a -> b -> LargeKey a b
forall a b. a -> b -> LargeKey a b
LargeKey a
lo' b
hi' where
lo' :: a
lo' = a
alo a -> a -> a
forall a. Num a => a -> a -> a
+ a
blo
hi' :: b
hi' = b
ahi b -> b -> b
forall a. Num a => a -> a -> a
+ b
bhi b -> b -> b
forall a. Num a => a -> a -> a
+ if a
lo' a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
alo then b
1 else b
0
largeWordMinus :: LargeKey a b -> LargeKey a b -> LargeKey a b
largeWordMinus (LargeKey a
alo b
ahi) (LargeKey a
blo b
bhi) =
a -> b -> LargeKey a b
forall a b. a -> b -> LargeKey a b
LargeKey a
lo' b
hi' where
lo' :: a
lo' = a
alo a -> a -> a
forall a. Num a => a -> a -> a
- a
blo
hi' :: b
hi' = b
ahi b -> b -> b
forall a. Num a => a -> a -> a
- b
bhi b -> b -> b
forall a. Num a => a -> a -> a
- if a
lo' a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
alo then b
1 else b
0
largeWordAnd :: LargeKey a b -> LargeKey a b -> LargeKey a b
largeWordAnd (LargeKey a
alo b
ahi) (LargeKey a
blo b
bhi) =
a -> b -> LargeKey a b
forall a b. a -> b -> LargeKey a b
LargeKey a
lo' b
hi' where
lo' :: a
lo' = a
alo a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
blo
hi' :: b
hi' = b
ahi b -> b -> b
forall a. Bits a => a -> a -> a
.&. b
bhi
largeWordOr :: LargeKey a b -> LargeKey a b -> LargeKey a b
largeWordOr (LargeKey a
alo b
ahi) (LargeKey a
blo b
bhi) =
a -> b -> LargeKey a b
forall a b. a -> b -> LargeKey a b
LargeKey a
lo' b
hi' where
lo' :: a
lo' = a
alo a -> a -> a
forall a. Bits a => a -> a -> a
.|. a
blo
hi' :: b
hi' = b
ahi b -> b -> b
forall a. Bits a => a -> a -> a
.|. b
bhi
largeWordXor :: LargeKey a b -> LargeKey a b -> LargeKey a b
largeWordXor (LargeKey a
alo b
ahi) (LargeKey a
blo b
bhi) =
a -> b -> LargeKey a b
forall a b. a -> b -> LargeKey a b
LargeKey a
lo' b
hi' where
lo' :: a
lo' = a
alo a -> a -> a
forall a. Bits a => a -> a -> a
`xor` a
blo
hi' :: b
hi' = b
ahi b -> b -> b
forall a. Bits a => a -> a -> a
`xor` b
bhi
largeWordShift :: LargeKey a b -> Int -> LargeKey a b
largeWordShift LargeKey a b
w Int
0 = LargeKey a b
w
largeWordShift (LargeKey a
lo b
hi) Int
x =
if Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
then
if Int
loSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
hiSize
then
a -> b -> LargeKey a b
forall a b. a -> b -> LargeKey a b
LargeKey (a -> Int -> a
forall a. Bits a => a -> Int -> a
shift a
lo Int
x)
(b -> Int -> b
forall a. Bits a => a -> Int -> a
shift b
hi Int
x b -> b -> b
forall a. Bits a => a -> a -> a
.|. (b -> Int -> b
forall a. Bits a => a -> Int -> a
shift (a -> b
convab a
lo) (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- (a -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize a
lo))))
else
a -> b -> LargeKey a b
forall a b. a -> b -> LargeKey a b
LargeKey (a -> Int -> a
forall a. Bits a => a -> Int -> a
shift a
lo Int
x)
(b -> Int -> b
forall a. Bits a => a -> Int -> a
shift b
hi Int
x b -> b -> b
forall a. Bits a => a -> a -> a
.|. (a -> b
convab (a -> Int -> a
forall a. Bits a => a -> Int -> a
shift a
lo (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- (a -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize a
lo)))))
else
if Int
loSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
hiSize
then
a -> b -> LargeKey a b
forall a b. a -> b -> LargeKey a b
LargeKey (a -> Int -> a
forall a. Bits a => a -> Int -> a
shift a
lo Int
x a -> a -> a
forall a. Bits a => a -> a -> a
.|. (b -> a
convba (b -> Int -> b
forall a. Bits a => a -> Int -> a
shift b
hi (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (a -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize a
lo)))))
(b -> Int -> b
forall a. Bits a => a -> Int -> a
shift b
hi Int
x)
else
a -> b -> LargeKey a b
forall a b. a -> b -> LargeKey a b
LargeKey (a -> Int -> a
forall a. Bits a => a -> Int -> a
shift a
lo Int
x a -> a -> a
forall a. Bits a => a -> a -> a
.|. (a -> Int -> a
forall a. Bits a => a -> Int -> a
shift (b -> a
convba b
hi) (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (a -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize a
lo))))
(b -> Int -> b
forall a. Bits a => a -> Int -> a
shift b
hi Int
x)
where
loSize :: Int
loSize = a -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize a
lo
hiSize :: Int
hiSize = b -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize b
hi
convab :: a -> b
convab = Integer -> b
forall a. LargeWord a => Integer -> a
integerToLargeWord (Integer -> b) -> (a -> Integer) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Integer
forall a. LargeWord a => a -> Integer
largeWordToInteger
convba :: b -> a
convba = Integer -> a
forall a. LargeWord a => Integer -> a
integerToLargeWord (Integer -> a) -> (b -> Integer) -> b -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Integer
forall a. LargeWord a => a -> Integer
largeWordToInteger
largeBitSize :: LargeKey a b -> Int
largeBitSize ~(LargeKey a
lo b
hi) = a -> Int
forall a. LargeWord a => a -> Int
largeBitSize a
lo Int -> Int -> Int
forall a. Num a => a -> a -> a
+ b -> Int
forall a. LargeWord a => a -> Int
largeBitSize b
hi
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 :: Int -> LargeKey a b -> ShowS
showsPrec Int
_p = Integer -> ShowS
forall a. Integral a => a -> ShowS
showInt (Integer -> ShowS)
-> (LargeKey a b -> Integer) -> LargeKey a b -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LargeKey a b -> Integer
forall a. LargeWord a => a -> Integer
largeWordToInteger
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
+ :: LargeKey a b -> LargeKey a b -> LargeKey a b
(+) = LargeKey a b -> LargeKey a b -> LargeKey a b
forall a. LargeWord a => a -> a -> a
largeWordPlus
(-) = LargeKey a b -> LargeKey a b -> LargeKey a b
forall a. LargeWord a => a -> a -> a
largeWordMinus
* :: LargeKey a b -> LargeKey a b -> LargeKey a b
(*) LargeKey a b
a LargeKey a b
b = Int -> LargeKey a b -> LargeKey a b
go Int
0 LargeKey a b
0
where
go :: Int -> LargeKey a b -> LargeKey a b
go Int
i LargeKey a b
r
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== LargeKey a b -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize LargeKey a b
r = LargeKey a b
r
| LargeKey a b -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit LargeKey a b
b Int
i = Int -> LargeKey a b -> LargeKey a b
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (LargeKey a b
r LargeKey a b -> LargeKey a b -> LargeKey a b
forall a. Num a => a -> a -> a
+ (LargeKey a b
a LargeKey a b -> Int -> LargeKey a b
forall a. Bits a => a -> Int -> a
`shiftL` Int
i))
| Bool
otherwise = Int -> LargeKey a b -> LargeKey a b
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) LargeKey a b
r
negate :: LargeKey a b -> LargeKey a b
negate = LargeKey a b -> LargeKey a b
forall a. a -> a
id
abs :: LargeKey a b -> LargeKey a b
abs = LargeKey a b -> LargeKey a b
forall a. a -> a
id
signum :: LargeKey a b -> LargeKey a b
signum LargeKey a b
a = if LargeKey a b
a LargeKey a b -> LargeKey a b -> Bool
forall a. Ord a => a -> a -> Bool
> LargeKey a b
0 then LargeKey a b
1 else LargeKey a b
0
fromInteger :: Integer -> LargeKey a b
fromInteger = Integer -> LargeKey a b
forall a. LargeWord a => Integer -> a
integerToLargeWord
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
.&. :: LargeKey a b -> LargeKey a b -> LargeKey a b
(.&.) = LargeKey a b -> LargeKey a b -> LargeKey a b
forall a. LargeWord a => a -> a -> a
largeWordAnd
.|. :: LargeKey a b -> LargeKey a b -> LargeKey a b
(.|.) = LargeKey a b -> LargeKey a b -> LargeKey a b
forall a. LargeWord a => a -> a -> a
largeWordOr
xor :: LargeKey a b -> LargeKey a b -> LargeKey a b
xor = LargeKey a b -> LargeKey a b -> LargeKey a b
forall a. LargeWord a => a -> a -> a
largeWordXor
shift :: LargeKey a b -> Int -> LargeKey a b
shift = LargeKey a b -> Int -> LargeKey a b
forall a. LargeWord a => a -> Int -> a
largeWordShift
LargeKey a b
x rotate :: LargeKey a b -> Int -> LargeKey a b
`rotate` Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = (LargeKey a b
x LargeKey a b -> Int -> LargeKey a b
forall a. LargeWord a => a -> Int -> a
`largeWordShift` Int
i) LargeKey a b -> LargeKey a b -> LargeKey a b
forall a. Bits a => a -> a -> a
.|.
(LargeKey a b
x LargeKey a b -> Int -> LargeKey a b
forall a. LargeWord a => a -> Int -> a
`largeWordShift` (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ LargeKey a b -> Int
forall a. LargeWord a => a -> Int
largeBitSize LargeKey a b
x))
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = LargeKey a b
x
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = (LargeKey a b
x LargeKey a b -> Int -> LargeKey a b
forall a. LargeWord a => a -> Int -> a
`largeWordShift` Int
i) LargeKey a b -> LargeKey a b -> LargeKey a b
forall a. Bits a => a -> a -> a
.|.
(LargeKey a b
x LargeKey a b -> Int -> LargeKey a b
forall a. LargeWord a => a -> Int -> a
`largeWordShift` (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- LargeKey a b -> Int
forall a. LargeWord a => a -> Int
largeBitSize LargeKey a b
x))
| Bool
otherwise = String -> LargeKey a b
forall a. HasCallStack => String -> a
error (String -> LargeKey a b) -> String -> LargeKey a b
forall a b. (a -> b) -> a -> b
$ String
"Clearly i must be < 0, == 0 or > 0" String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
"but ghc can't determine this"
complement :: LargeKey a b -> LargeKey a b
complement (LargeKey a
a b
b) = a -> b -> LargeKey a b
forall a b. a -> b -> LargeKey a b
LargeKey (a -> a
forall a. Bits a => a -> a
complement a
a) (b -> b
forall a. Bits a => a -> a
complement b
b)
bitSize :: LargeKey a b -> Int
bitSize = LargeKey a b -> Int
forall a. LargeWord a => a -> Int
largeBitSize
#if MIN_VERSION_base(4,7,0)
bitSizeMaybe :: LargeKey a b -> Maybe Int
bitSizeMaybe = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int)
-> (LargeKey a b -> Int) -> LargeKey a b -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LargeKey a b -> Int
forall a. LargeWord a => a -> Int
largeBitSize
#endif
isSigned :: LargeKey a b -> Bool
isSigned LargeKey a b
_ = Bool
False
#if MIN_VERSION_base(4,6,0)
bit :: Int -> LargeKey a b
bit = Int -> LargeKey a b
forall a. (Bits a, Num a) => Int -> a
bitDefault
testBit :: LargeKey a b -> Int -> Bool
testBit = LargeKey a b -> Int -> Bool
forall a. (Bits a, Num a) => a -> Int -> Bool
testBitDefault
popCount :: LargeKey a b -> Int
popCount = LargeKey a b -> Int
forall a. (Bits a, Num a) => a -> Int
popCountDefault
#endif
instance (LargeWord a, Bits a, FiniteBits a, Ord a, Num a,
LargeWord b, Bits b, FiniteBits b, Ord b, Num b) => FiniteBits (LargeKey a b) where
finiteBitSize :: LargeKey a b -> Int
finiteBitSize = LargeKey a b -> Int
forall a. LargeWord a => a -> Int
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 :: LargeKey a b
minBound = LargeKey a b
0
maxBound :: LargeKey a b
maxBound =
LargeKey a b
result where
result :: LargeKey a b
result =
Integer -> LargeKey a b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> LargeKey a b) -> Integer -> LargeKey a b
forall a b. (a -> b) -> a -> b
$
(Integer
1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ b -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (b
forall a. Bounded a => a
maxBound b -> b -> b
forall a. a -> a -> a
`asTypeOf` (LargeKey a b -> b
forall a b. LargeKey a b -> b
boflk LargeKey a b
result)))Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*
(Integer
1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ a -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
forall a. Bounded a => a
maxBound a -> a -> a
forall a. a -> a -> a
`asTypeOf` (LargeKey a b -> a
forall a b. LargeKey a b -> a
aoflk LargeKey a b
result))) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1
aoflk :: (LargeKey a b) -> a
aoflk :: LargeKey a b -> a
aoflk = LargeKey a b -> a
forall a. HasCallStack => a
undefined
boflk :: (LargeKey a b) -> b
boflk :: LargeKey a b -> b
boflk = LargeKey a b -> b
forall a. HasCallStack => a
undefined
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 :: LargeKey a b -> Integer
toInteger = LargeKey a b -> Integer
forall a. LargeWord a => a -> Integer
largeWordToInteger
quotRem :: LargeKey a b -> LargeKey a b -> (LargeKey a b, LargeKey a b)
quotRem LargeKey a b
a LargeKey a b
b =
let r :: LargeKey a b
r = LargeKey a b
a LargeKey a b -> LargeKey a b -> LargeKey a b
forall a. Num a => a -> a -> a
- LargeKey a b
qLargeKey a b -> LargeKey a b -> LargeKey a b
forall a. Num a => a -> a -> a
*LargeKey a b
b
q :: LargeKey a b
q = LargeKey a b -> Int -> LargeKey a b -> LargeKey a b
forall t. (Num t, Bits t) => t -> Int -> LargeKey a b -> t
go LargeKey a b
0 (LargeKey a b -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize LargeKey a b
a) LargeKey a b
0
in (LargeKey a b
q,LargeKey a b
r)
where
go :: t -> Int -> LargeKey a b -> t
go t
t Int
0 LargeKey a b
v = if LargeKey a b
v LargeKey a b -> LargeKey a b -> Bool
forall a. Ord a => a -> a -> Bool
>= LargeKey a b
b then t
tt -> t -> t
forall a. Num a => a -> a -> a
+t
1 else t
t
go t
t Int
i LargeKey a b
v
| LargeKey a b
v LargeKey a b -> LargeKey a b -> Bool
forall a. Ord a => a -> a -> Bool
>= LargeKey a b
b = t -> Int -> LargeKey a b -> t
go (t -> Int -> t
forall a. Bits a => a -> Int -> a
setBit t
t Int
i) Int
i' LargeKey a b
v2
| Bool
otherwise = t -> Int -> LargeKey a b -> t
go t
t Int
i' LargeKey a b
v1
where i' :: Int
i' = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
newBit :: LargeKey a b
newBit = if (LargeKey a b -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit LargeKey a b
a Int
i') then LargeKey a b
1 else LargeKey a b
0
v1 :: LargeKey a b
v1 = (LargeKey a b
v LargeKey a b -> Int -> LargeKey a b
forall a. Bits a => a -> Int -> a
`shiftL` Int
1) LargeKey a b -> LargeKey a b -> LargeKey a b
forall a. Bits a => a -> a -> a
.|. LargeKey a b
newBit
v2 :: LargeKey a b
v2 = ((LargeKey a b
v LargeKey a b -> LargeKey a b -> LargeKey a b
forall a. Num a => a -> a -> a
- LargeKey a b
b) LargeKey a b -> Int -> LargeKey a b
forall a. Bits a => a -> Int -> a
`shiftL` Int
1) LargeKey a b -> LargeKey a b -> LargeKey a b
forall a. Bits a => a -> a -> a
.|. LargeKey a b
newBit
divMod :: LargeKey a b -> LargeKey a b -> (LargeKey a b, LargeKey a b)
divMod = LargeKey a b -> LargeKey a b -> (LargeKey a b, LargeKey a b)
forall a. Integral a => a -> a -> (a, a)
quotRem
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 :: LargeKey a b -> Rational
toRational LargeKey a b
w = Integer -> Rational
forall a. Real a => a -> Rational
toRational (LargeKey a b -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral LargeKey a b
w :: Integer)
instance (Eq a, Bounded a, Num a, Enum b, Enum a, Bounded b, Num b) => Enum (LargeKey a b) where
toEnum :: Int -> LargeKey a b
toEnum Int
i = a -> b -> LargeKey a b
forall a b. a -> b -> LargeKey a b
LargeKey (Int -> a
forall a. Enum a => Int -> a
toEnum Int
i) b
0
fromEnum :: LargeKey a b -> Int
fromEnum (LargeKey a
l b
_) = a -> Int
forall a. Enum a => a -> Int
fromEnum a
l
pred :: LargeKey a b -> LargeKey a b
pred (LargeKey a
0 b
h) = a -> b -> LargeKey a b
forall a b. a -> b -> LargeKey a b
LargeKey a
forall a. Bounded a => a
maxBound (b -> b
forall a. Enum a => a -> a
pred b
h)
pred (LargeKey a
l b
h) = a -> b -> LargeKey a b
forall a b. a -> b -> LargeKey a b
LargeKey (a -> a
forall a. Enum a => a -> a
pred a
l) b
h
succ :: LargeKey a b -> LargeKey a b
succ (LargeKey a
l b
h) = if a
l a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Bounded a => a
maxBound then a -> b -> LargeKey a b
forall a b. a -> b -> LargeKey a b
LargeKey a
0 (b -> b
forall a. Enum a => a -> a
succ b
h)
else a -> b -> LargeKey a b
forall a b. a -> b -> LargeKey a b
LargeKey (a -> a
forall a. Enum a => a -> a
succ a
l) b
h
instance (Binary a, Binary b) => Binary (LargeKey a b) where
put :: LargeKey a b -> Put
put (LargeKey a
lo b
hi) = b -> Put
forall t. Binary t => t -> Put
put b
hi Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> Put
forall t. Binary t => t -> Put
put a
lo
get :: Get (LargeKey a b)
get = (a -> b -> LargeKey a b) -> b -> a -> LargeKey a b
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> b -> LargeKey a b
forall a b. a -> b -> LargeKey a b
LargeKey (b -> a -> LargeKey a b) -> Get b -> Get (a -> LargeKey a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get b
forall t. Binary t => Get t
get Get (a -> LargeKey a b) -> Get a -> Get (LargeKey a b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get a
forall t. Binary t => Get t
get
instance (Ord a, Ord b) => Ord (LargeKey a b) where
compare :: LargeKey a b -> LargeKey a b -> Ordering
compare LargeKey a b
a LargeKey a b
b = (b, a) -> (b, a) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (LargeKey a b -> b
forall a b. LargeKey a b -> b
hiHalf LargeKey a b
a, LargeKey a b -> a
forall a b. LargeKey a b -> a
loHalf LargeKey a b
a) (LargeKey a b -> b
forall a b. LargeKey a b -> b
hiHalf LargeKey a b
b, LargeKey a b -> a
forall a b. LargeKey a b -> a
loHalf LargeKey a b
b)
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