-----------------------------------------------------------------------------
-- |
-- Module      :  Data.LargeWord
-- Copyright   :  (c) Dominic Steinitz 2004
-- License     :  BSD-style (see the file ReadMe.tex)
--
-- 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) where

import Data.Word
import Data.Bits
import Numeric
import Data.Char

-- Keys have certain capabilities.

class (Num a) => LargeWord a where
   largeWordToInteger :: a -> Integer
   integerToLargeWord :: Integer -> a
   largeWordPlus :: a -> a -> a
   largeWordAnd :: a -> a -> a
   largeWordOr :: a -> a -> a
   largeWordShift :: a -> Int -> a
   largeWordXor :: a -> a -> a
   largeBitSize :: a -> Int

-- Word32 is a key in the obvious way.

instance LargeWord Word32 where
   largeWordToInteger :: Word32 -> Integer
largeWordToInteger = forall a. Integral a => a -> Integer
toInteger
   integerToLargeWord :: Integer -> Word32
integerToLargeWord = forall a. Num a => Integer -> a
fromInteger
   largeWordPlus :: Word32 -> Word32 -> Word32
largeWordPlus = forall a. Num a => a -> a -> a
(+)
   largeWordAnd :: Word32 -> Word32 -> Word32
largeWordAnd = forall a. Bits a => a -> a -> a
(.&.)
   largeWordOr :: Word32 -> Word32 -> Word32
largeWordOr = forall a. Bits a => a -> a -> a
(.|.)
   largeWordShift :: Word32 -> Int -> Word32
largeWordShift = forall a. Bits a => a -> Int -> a
shift
   largeWordXor :: Word32 -> Word32 -> Word32
largeWordXor = forall a. Bits a => a -> a -> a
xor
   largeBitSize :: Word32 -> Int
largeBitSize = forall a. Bits a => a -> Int
bitSize

-- Word64 is a key in the obvious way.

instance LargeWord Word64 where
   largeWordToInteger :: Word64 -> Integer
largeWordToInteger = forall a. Integral a => a -> Integer
toInteger
   integerToLargeWord :: Integer -> Word64
integerToLargeWord = forall a. Num a => Integer -> a
fromInteger
   largeWordPlus :: Word64 -> Word64 -> Word64
largeWordPlus = forall a. Num a => a -> a -> a
(+)
   largeWordAnd :: Word64 -> Word64 -> Word64
largeWordAnd = forall a. Bits a => a -> a -> a
(.&.)
   largeWordOr :: Word64 -> Word64 -> Word64
largeWordOr = forall a. Bits a => a -> a -> a
(.|.)
   largeWordShift :: Word64 -> Int -> Word64
largeWordShift = forall a. Bits a => a -> Int -> a
shift
   largeWordXor :: Word64 -> Word64 -> Word64
largeWordXor = forall a. Bits a => a -> a -> a
xor
   largeBitSize :: Word64 -> Int
largeBitSize = forall a. Bits a => a -> Int
bitSize

-- Define larger keys from smaller ones.

data LargeKey a b = LargeKey a b
   deriving (LargeKey a b -> LargeKey a b -> Bool
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, LargeKey a b -> LargeKey a b -> Bool
LargeKey a b -> LargeKey a b -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a} {b}. (Ord a, Ord b) => Eq (LargeKey a b)
forall a b. (Ord a, Ord b) => LargeKey a b -> LargeKey a b -> Bool
forall a b.
(Ord a, Ord b) =>
LargeKey a b -> LargeKey a b -> Ordering
forall a b.
(Ord a, Ord b) =>
LargeKey a b -> LargeKey a b -> LargeKey a b
min :: LargeKey a b -> LargeKey a b -> LargeKey a b
$cmin :: forall a b.
(Ord a, Ord b) =>
LargeKey a b -> LargeKey a b -> LargeKey a b
max :: LargeKey a b -> LargeKey a b -> LargeKey a b
$cmax :: forall a b.
(Ord a, Ord b) =>
LargeKey a b -> LargeKey a b -> LargeKey a b
>= :: LargeKey a b -> LargeKey a b -> Bool
$c>= :: forall a b. (Ord a, Ord b) => LargeKey a b -> LargeKey a b -> Bool
> :: LargeKey a b -> LargeKey a b -> Bool
$c> :: forall a b. (Ord a, Ord b) => LargeKey a b -> LargeKey a b -> Bool
<= :: LargeKey a b -> LargeKey a b -> Bool
$c<= :: forall a b. (Ord a, Ord b) => LargeKey a b -> LargeKey a b -> Bool
< :: LargeKey a b -> LargeKey a b -> Bool
$c< :: forall a b. (Ord a, Ord b) => LargeKey a b -> LargeKey a b -> Bool
compare :: LargeKey a b -> LargeKey a b -> Ordering
$ccompare :: forall a b.
(Ord a, Ord b) =>
LargeKey a b -> LargeKey a b -> Ordering
Ord)

instance (Ord a, Bits a, LargeWord a, Bits b, LargeWord b) =>
   LargeWord (LargeKey a b) where
      largeWordToInteger :: LargeKey a b -> Integer
largeWordToInteger (LargeKey a
lo b
hi) =
         forall a. LargeWord a => a -> Integer
largeWordToInteger a
lo forall a. Num a => a -> a -> a
+ (Integer
2forall a b. (Num a, Integral b) => a -> b -> a
^(forall a. Bits a => a -> Int
bitSize a
lo)) forall a. Num a => a -> a -> a
* forall a. LargeWord a => a -> Integer
largeWordToInteger b
hi
      integerToLargeWord :: Integer -> LargeKey a b
integerToLargeWord Integer
x =
         let (Integer
h,Integer
l) =  Integer
x forall a. Integral a => a -> a -> (a, a)
`quotRem` (Integer
2forall a b. (Num a, Integral b) => a -> b -> a
^(forall a. Bits a => a -> Int
bitSize a
lo))
             (a
lo,b
hi) = (forall a. LargeWord a => Integer -> a
integerToLargeWord Integer
l, forall a. LargeWord a => Integer -> a
integerToLargeWord Integer
h) in
                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) =
         forall a b. a -> b -> LargeKey a b
LargeKey a
lo' b
hi' where
            lo' :: a
lo' = a
alo forall a. Num a => a -> a -> a
+ a
blo
            hi' :: b
hi' = b
ahi forall a. Num a => a -> a -> a
+ b
bhi forall a. Num a => a -> a -> a
+ if a
lo' 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) =
         forall a b. a -> b -> LargeKey a b
LargeKey a
lo' b
hi' where
            lo' :: a
lo' = a
alo forall a. Bits a => a -> a -> a
.&. a
blo
            hi' :: b
hi' = b
ahi 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) =
         forall a b. a -> b -> LargeKey a b
LargeKey a
lo' b
hi' where
            lo' :: a
lo' = a
alo forall a. Bits a => a -> a -> a
.|. a
blo
            hi' :: b
hi' = b
ahi 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) =
         forall a b. a -> b -> LargeKey a b
LargeKey a
lo' b
hi' where
            lo' :: a
lo' = a
alo forall a. Bits a => a -> a -> a
`xor` a
blo
            hi' :: b
hi' = b
ahi 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 forall a. Bits a => a -> Int
bitSize a
lo forall a. Ord a => a -> a -> Bool
< forall a. Bits a => a -> Int
bitSize b
hi
            then forall a b. a -> b -> LargeKey a b
LargeKey (forall a. Bits a => a -> Int -> a
shift a
lo Int
x)
                          (forall a. Bits a => a -> Int -> a
shift b
hi Int
x forall a. Bits a => a -> a -> a
.|. (forall a. Bits a => a -> Int -> a
shift (a -> b
conv a
lo) (Int
x forall a. Num a => a -> a -> a
- (forall a. Bits a => a -> Int
bitSize a
lo))))
            else forall a b. a -> b -> LargeKey a b
LargeKey (forall a. Bits a => a -> Int -> a
shift a
lo Int
x)
                          (forall a. Bits a => a -> Int -> a
shift b
hi Int
x forall a. Bits a => a -> a -> a
.|. (a -> b
conv forall a b. (a -> b) -> a -> b
$ forall a. Bits a => a -> Int -> a
shift a
lo (Int
x forall a. Num a => a -> a -> a
- (forall a. Bits a => a -> Int
bitSize a
lo))))
         where conv :: a -> b
conv = forall a. LargeWord a => Integer -> a
integerToLargeWord forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. LargeWord a => a -> Integer
largeWordToInteger
      largeBitSize :: LargeKey a b -> Int
largeBitSize ~(LargeKey a
lo b
hi) = forall a. LargeWord a => a -> Int
largeBitSize a
lo forall a. Num a => a -> a -> a
+ forall a. LargeWord a => a -> Int
largeBitSize b
hi

instance (Ord a, Bits a, LargeWord a, Bits b, LargeWord b) => Show (LargeKey a b) where
   showsPrec :: Int -> LargeKey a b -> ShowS
showsPrec Int
p = forall a. Integral a => a -> ShowS
showInt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. LargeWord a => a -> Integer
largeWordToInteger

instance (Ord a, Bits a, LargeWord a, Bits b, LargeWord b) =>
   Num (LargeKey a b) where
      + :: LargeKey a b -> LargeKey a b -> LargeKey a b
(+) = forall a. LargeWord a => a -> a -> a
largeWordPlus
      fromInteger :: Integer -> LargeKey a b
fromInteger = forall a. LargeWord a => Integer -> a
integerToLargeWord

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

instance (Ord a, Bits a, LargeWord a, Bits b, LargeWord b) =>
   Bits (LargeKey a b) where
      .&. :: 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
(.|.) = forall a. LargeWord a => a -> a -> a
largeWordOr
      xor :: LargeKey a b -> LargeKey a b -> LargeKey a b
xor = forall a. LargeWord a => a -> a -> a
largeWordXor
      shift :: LargeKey a b -> Int -> LargeKey a b
shift = forall a. LargeWord a => a -> Int -> a
largeWordShift
      bitSize :: LargeKey a b -> Int
bitSize = forall a. LargeWord a => a -> Int
largeBitSize

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 :: LargeKey a b
minBound = LargeKey a b
0
      maxBound :: LargeKey a b
maxBound =
         LargeKey a b
result where
            result :: LargeKey a b
result =
               forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$
               (Integer
1 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound forall a. a -> a -> a
`asTypeOf` (forall a b. LargeKey a b -> b
boflk LargeKey a b
result)))forall a. Num a => a -> a -> a
*
                  (Integer
1 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound forall a. a -> a -> a
`asTypeOf` (forall a b. LargeKey a b -> a
aoflk LargeKey a b
result))) forall a. Num a => a -> a -> a
- Integer
1

aoflk :: (LargeKey a b) -> a
aoflk :: forall a b. LargeKey a b -> a
aoflk = forall a. HasCallStack => a
undefined
boflk :: (LargeKey a b) -> b
boflk :: forall a b. LargeKey a b -> b
boflk = forall a. HasCallStack => a
undefined

instance (Ord a, Bits a, LargeWord a, Ord b, Bits b, LargeWord b) =>
   Integral (LargeKey a b) where
      toInteger :: LargeKey a b -> Integer
toInteger = forall a. LargeWord a => a -> Integer
largeWordToInteger

instance (Ord a, Bits a, LargeWord a, Ord b, Bits b, LargeWord b) =>
   Real (LargeKey a b)

instance Enum (LargeKey a 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