{-# 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 - 2014
-- 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 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

-- 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 :: 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

-- Word16 is a key in the obvious way

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

-- Word32 is a key in the obvious way.

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

-- Word64 is a key in the obvious way.

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

-- Define larger keys from smaller ones.

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

-- Larger keys are instances of Bits provided their constituents are keys.

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
       -- Trivial long division
       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