{-# LANGUAGE CPP #-}
{-# LANGUAGE UnicodeSyntax #-}
#if __GLASGOW_HASKELL__ >= 705
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE BangPatterns #-}
#endif
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}

#include "MachDeps.h"

-- | Extra operations on binary words of fixed length.
module Data.BinaryWord
  ( BinaryWord(..)
  , lMsb
  , lLsb
  ) where

import Data.Int
import Data.Word
import Data.Bits (Bits(..))
#if MIN_VERSION_base(4,7,0)
import Data.Bits (FiniteBits(..))
#endif
#if __GLASGOW_HASKELL__ >= 705
import GHC.Prim (plusWord2#, timesWord2#)
# if __GLASGOW_HASKELL__ >= 904
import GHC.Prim (word64ToWord#, wordToWord64#)
# endif
# if WORD_SIZE_IN_BITS == 32
import GHC.Word (Word32(..))
# endif
# if WORD_SIZE_IN_BITS == 64
import GHC.Word (Word64(..))
# endif
#endif

-- | Two's complement, fixed length binary words.
#if MIN_VERSION_base(4,7,0)
class (FiniteBits w, FiniteBits (UnsignedWord w), FiniteBits (SignedWord w))
#else
class (Bits w, Bits (UnsignedWord w), Bits (SignedWord w))
#endif
      ⇒ BinaryWord w where
  -- | The unsigned variant type
  type UnsignedWord w
  -- | The signed variant type
  type SignedWord w
  -- | Convert the word to the unsigned type (identical to 'fromIntegral')
  unsignedWord ∷ w → UnsignedWord w
  -- | Convert the word to the signed type (identical to 'fromIntegral')
  signedWord ∷ w → SignedWord w
  -- | Unwrapped addition
  unwrappedAdd ∷ w → w → (w, UnsignedWord w)
  -- | Unwrapped multiplication
  unwrappedMul ∷ w → w → (w, UnsignedWord w)
  -- | Number of leading (from MSB) zero bits
  leadingZeroes ∷ w → Int
  -- | Number or trailing (from LSB) zero bits
  trailingZeroes ∷ w → Int
  -- | The word with all bits set to 0
  allZeroes ∷ w
  -- | The word with all bits set to 1
  allOnes ∷ w
  -- | The word with MSB set to 1 and all the other bits set to 0
  msb ∷ w
  -- | The word with LSB set to 1 and all the other bits set to 0
  lsb ∷ w
  lsb = forall a. Bits a => Int -> a
bit Int
0
  {-# INLINE lsb #-}
  -- | Test if the MSB is 1
  testMsb ∷ w → Bool
  -- | Test if the LSB is 1
  testLsb ∷ w → Bool
  testLsb = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Bits a => a -> Int -> Bool
testBit Int
0
  {-# INLINE testLsb #-}
  -- | Set the MSB to 1
  setMsb ∷ w → w
  -- | Set the LSB to 1
  setLsb ∷ w → w
  setLsb = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Bits a => a -> Int -> a
setBit Int
0
  {-# INLINE setLsb #-}
  -- | Set the MSB to 0
  clearMsb ∷ w → w
  -- | Set the LSB to 0
  clearLsb ∷ w → w
  clearLsb = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Bits a => a -> Int -> a
clearBit Int
0
  {-# INLINE clearLsb #-}

-- | MSB lens.
lMsb ∷ (Functor f, BinaryWord w) ⇒ (Bool → f Bool) → w → f w
lMsb :: forall (f :: * -> *) w.
(Functor f, BinaryWord w) =>
(Bool -> f Bool) -> w -> f w
lMsb Bool -> f Bool
f w
w = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Bool
x → if Bool
x then forall w. BinaryWord w => w -> w
setMsb w
w else forall w. BinaryWord w => w -> w
clearMsb w
w) (Bool -> f Bool
f (forall w. BinaryWord w => w -> Bool
testMsb w
w))

-- | LSB lens.
lLsb ∷ (Functor f, BinaryWord w) ⇒ (Bool → f Bool) → w → f w
lLsb :: forall (f :: * -> *) w.
(Functor f, BinaryWord w) =>
(Bool -> f Bool) -> w -> f w
lLsb Bool -> f Bool
f w
w = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Bool
x → if Bool
x then forall w. BinaryWord w => w -> w
setLsb w
w else forall w. BinaryWord w => w -> w
clearLsb w
w) (Bool -> f Bool
f (forall w. BinaryWord w => w -> Bool
testLsb w
w))

instance BinaryWord Word8 where
  type UnsignedWord Word8 = Word8
  type SignedWord Word8 = Int8
  unsignedWord :: Word8 -> UnsignedWord Word8
unsignedWord = forall a. a -> a
id
  {-# INLINE unsignedWord #-}
  signedWord :: Word8 -> SignedWord Word8
signedWord = forall a b. (Integral a, Num b) => a -> b
fromIntegral
  {-# INLINE signedWord #-}
  unwrappedAdd :: Word8 -> Word8 -> (Word8, UnsignedWord Word8)
unwrappedAdd Word8
x Word8
y = Word8
hi seq :: forall a b. a -> b -> b
`seq` Word8
lo seq :: forall a b. a -> b -> b
`seq` (Word8
hi, Word8
lo)
    where s :: Word16
s = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
x forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
y ∷ Word16
          lo :: Word8
lo = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
s
          hi :: Word8
hi = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Word16
s Int
8)
  {-# INLINE unwrappedAdd #-}
  unwrappedMul :: Word8 -> Word8 -> (Word8, UnsignedWord Word8)
unwrappedMul Word8
x Word8
y = Word8
hi seq :: forall a b. a -> b -> b
`seq` Word8
lo seq :: forall a b. a -> b -> b
`seq` (Word8
hi, Word8
lo)
    where p :: Word16
p = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
x forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
y ∷ Word16
          lo :: Word8
lo = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
p
          hi :: Word8
hi = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Word16
p Int
8)
  {-# INLINE unwrappedMul #-}
#if MIN_VERSION_base(4,8,0)
  leadingZeroes :: Word8 -> Int
leadingZeroes = forall b. FiniteBits b => b -> Int
countLeadingZeros
  {-# INLINE leadingZeroes #-}
  trailingZeroes :: Word8 -> Int
trailingZeroes = forall b. FiniteBits b => b -> Int
countTrailingZeros
  {-# INLINE trailingZeroes #-}
#else
  leadingZeroes w | w .&. 0xF0 == 0 = go4 4 w
                  | otherwise       = go4 0 (shiftR w 4)
    where go4 off w' | w' .&. 8 /= 0 = off
                     | w' .&. 4 /= 0 = off + 1
                     | w' .&. 2 /= 0 = off + 2
                     | w' .&. 1 /= 0 = off + 3
                     | otherwise     = off + 4
  trailingZeroes w | w .&. 0x0F == 0 = go4 4 (shiftR w 4)
                   | otherwise       = go4 0 w
    where go4 off w' | w' .&. 1 /= 0 = off
                     | w' .&. 2 /= 0 = off + 1
                     | w' .&. 4 /= 0 = off + 2
                     | w' .&. 8 /= 0 = off + 3
                     | otherwise     = off + 4
#endif
  allZeroes :: Word8
allZeroes = Word8
0
  {-# INLINE allZeroes #-}
  allOnes :: Word8
allOnes = Word8
0xFF
  {-# INLINE allOnes #-}
  msb :: Word8
msb = Word8
0x80
  {-# INLINE msb #-}
  lsb :: Word8
lsb = Word8
1
  {-# INLINE lsb #-}
  testMsb :: Word8 -> Bool
testMsb Word8
x = forall a. Bits a => a -> Int -> Bool
testBit Word8
x Int
7
  {-# INLINE testMsb #-}
  setMsb :: Word8 -> Word8
setMsb Word8
x = forall a. Bits a => a -> Int -> a
setBit Word8
x Int
7
  {-# INLINE setMsb #-}
  clearMsb :: Word8 -> Word8
clearMsb Word8
x = forall a. Bits a => a -> Int -> a
clearBit Word8
x Int
7
  {-# INLINE clearMsb #-}

instance BinaryWord Word16 where
  type UnsignedWord Word16 = Word16
  type SignedWord Word16 = Int16
  unsignedWord :: Word16 -> UnsignedWord Word16
unsignedWord = forall a. a -> a
id
  {-# INLINE unsignedWord #-}
  signedWord :: Word16 -> SignedWord Word16
signedWord = forall a b. (Integral a, Num b) => a -> b
fromIntegral
  {-# INLINE signedWord #-}
  unwrappedAdd :: Word16 -> Word16 -> (Word16, UnsignedWord Word16)
unwrappedAdd Word16
x Word16
y = Word16
hi seq :: forall a b. a -> b -> b
`seq` Word16
lo seq :: forall a b. a -> b -> b
`seq` (Word16
hi, Word16
lo)
    where s :: Word32
s  = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
x forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
y ∷ Word32
          lo :: Word16
lo = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
s
          hi :: Word16
hi = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Word32
s Int
16)
  {-# INLINE unwrappedAdd #-}
  unwrappedMul :: Word16 -> Word16 -> (Word16, UnsignedWord Word16)
unwrappedMul Word16
x Word16
y = Word16
hi seq :: forall a b. a -> b -> b
`seq` Word16
lo seq :: forall a b. a -> b -> b
`seq` (Word16
hi, Word16
lo)
    where p :: Word32
p  = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
x forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
y ∷ Word32
          lo :: Word16
lo = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
p
          hi :: Word16
hi = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Word32
p Int
16)
  {-# INLINE unwrappedMul #-}
#if MIN_VERSION_base(4,8,0)
  leadingZeroes :: Word16 -> Int
leadingZeroes = forall b. FiniteBits b => b -> Int
countLeadingZeros
  {-# INLINE leadingZeroes #-}
  trailingZeroes :: Word16 -> Int
trailingZeroes = forall b. FiniteBits b => b -> Int
countTrailingZeros
  {-# INLINE trailingZeroes #-}
#else
  leadingZeroes w | w .&. 0xFF00 == 0 = go8 8 w
                  | otherwise         = go8 0 (shiftR w 8)
    where
      go8 off w' | w' .&. 0xF0 == 0 = go4 (off + 4) w'
                 | otherwise        = go4 off (shiftR w' 4)
      go4 off w' | w' .&. 8 /= 0    = off
                 | w' .&. 4 /= 0    = off + 1
                 | w' .&. 2 /= 0    = off + 2
                 | w' .&. 1 /= 0    = off + 3
                 | otherwise        = off + 4
  trailingZeroes w | w .&. 0x00FF == 0 = go8 8 (shiftR w 8)
                   | otherwise         = go8 0 w
    where
      go8 off w' | w' .&. 0x0F == 0 = go4 (off + 4) (shiftR w' 4)
                 | otherwise        = go4 off w'
      go4 off w' | w' .&. 1 /= 0    = off
                 | w' .&. 2 /= 0    = off + 1
                 | w' .&. 4 /= 0    = off + 2
                 | w' .&. 8 /= 0    = off + 3
                 | otherwise        = off + 4
#endif
  allZeroes :: Word16
allZeroes = Word16
0
  {-# INLINE allZeroes #-}
  allOnes :: Word16
allOnes = Word16
0xFFFF
  {-# INLINE allOnes #-}
  msb :: Word16
msb = Word16
0x8000
  {-# INLINE msb #-}
  lsb :: Word16
lsb = Word16
1
  {-# INLINE lsb #-}
  testMsb :: Word16 -> Bool
testMsb Word16
x = forall a. Bits a => a -> Int -> Bool
testBit Word16
x Int
15
  {-# INLINE testMsb #-}
  setMsb :: Word16 -> Word16
setMsb Word16
x = forall a. Bits a => a -> Int -> a
setBit Word16
x Int
15
  {-# INLINE setMsb #-}
  clearMsb :: Word16 -> Word16
clearMsb Word16
x = forall a. Bits a => a -> Int -> a
clearBit Word16
x Int
15
  {-# INLINE clearMsb #-}

instance BinaryWord Word32 where
  type UnsignedWord Word32 = Word32
  type SignedWord Word32 = Int32
  unsignedWord :: Word32 -> UnsignedWord Word32
unsignedWord = forall a. a -> a
id
  {-# INLINE unsignedWord #-}
  signedWord :: Word32 -> SignedWord Word32
signedWord = forall a b. (Integral a, Num b) => a -> b
fromIntegral
  {-# INLINE signedWord #-}
#if __GLASGOW_HASKELL__ >= 705 && WORD_SIZE_IN_BITS == 32
  unwrappedAdd (W32# x) (W32# y) = hi `seq` lo `seq` (hi, lo)
    where !(# hi', lo' #) = plusWord2# x y
          lo = W32# lo'
          hi = W32# hi'
#else
  unwrappedAdd :: Word32 -> Word32 -> (Word32, UnsignedWord Word32)
unwrappedAdd Word32
x Word32
y = Word32
hi seq :: forall a b. a -> b -> b
`seq` Word32
lo seq :: forall a b. a -> b -> b
`seq` (Word32
hi, Word32
lo)
    where s :: Word64
s  = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
x forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
y ∷ Word64
          lo :: Word32
lo = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
s
          hi :: Word32
hi = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Word64
s Int
32)
#endif
  {-# INLINE unwrappedAdd #-}
#if __GLASGOW_HASKELL__ >= 705 && WORD_SIZE_IN_BITS == 32
  unwrappedMul (W32# x) (W32# y) = hi `seq` lo `seq` (hi, lo)
    where !(# hi', lo' #) = timesWord2# x y
          lo = W32# lo'
          hi = W32# hi'
#else
  unwrappedMul :: Word32 -> Word32 -> (Word32, UnsignedWord Word32)
unwrappedMul Word32
x Word32
y = Word32
hi seq :: forall a b. a -> b -> b
`seq` Word32
lo seq :: forall a b. a -> b -> b
`seq` (Word32
hi, Word32
lo)
    where p :: Word64
p  = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
x forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
y ∷ Word64
          lo :: Word32
lo = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
p
          hi :: Word32
hi = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Word64
p Int
32)
#endif
  {-# INLINE unwrappedMul #-}
#if MIN_VERSION_base(4,8,0)
  leadingZeroes :: Word32 -> Int
leadingZeroes = forall b. FiniteBits b => b -> Int
countLeadingZeros
  {-# INLINE leadingZeroes #-}
  trailingZeroes :: Word32 -> Int
trailingZeroes = forall b. FiniteBits b => b -> Int
countTrailingZeros
  {-# INLINE trailingZeroes #-}
#else
  leadingZeroes w | w .&. 0xFFFF0000 == 0 = go16 16 w
                  | otherwise             = go16 0 (shiftR w 16)
    where
      go16 off w' | w' .&. 0xFF00 == 0 = go8 (off + 8) w'
                  | otherwise          = go8 off (shiftR w' 8)
      go8  off w' | w' .&. 0xF0 == 0   = go4 (off + 4) w'
                  | otherwise          = go4 off (shiftR w' 4)
      go4  off w' | w' .&. 8 /= 0      = off
                  | w' .&. 4 /= 0      = off + 1
                  | w' .&. 2 /= 0      = off + 2
                  | w' .&. 1 /= 0      = off + 3
                  | otherwise          = off + 4
  trailingZeroes w | w .&. 0x0000FFFF == 0 = go16 16 (shiftR w 16)
                   | otherwise             = go16 0 w
    where
      go16 off w' | w' .&. 0x00FF == 0 = go8 (off + 8) (shiftR w' 8)
                  | otherwise          = go8 off w'
      go8  off w' | w' .&. 0x0F == 0   = go4 (off + 4) (shiftR w' 4)
                  | otherwise          = go4 off w'
      go4  off w' | w' .&. 1 /= 0      = off
                  | w' .&. 2 /= 0      = off + 1
                  | w' .&. 4 /= 0      = off + 2
                  | w' .&. 8 /= 0      = off + 3
                  | otherwise          = off + 4
#endif
  allZeroes :: Word32
allZeroes = Word32
0
  {-# INLINE allZeroes #-}
  allOnes :: Word32
allOnes = Word32
0xFFFFFFFF
  {-# INLINE allOnes #-}
  msb :: Word32
msb = Word32
0x80000000
  {-# INLINE msb #-}
  lsb :: Word32
lsb = Word32
1
  {-# INLINE lsb #-}
  testMsb :: Word32 -> Bool
testMsb Word32
x = forall a. Bits a => a -> Int -> Bool
testBit Word32
x Int
31
  {-# INLINE testMsb #-}
  setMsb :: Word32 -> Word32
setMsb Word32
x = forall a. Bits a => a -> Int -> a
setBit Word32
x Int
31
  {-# INLINE setMsb #-}
  clearMsb :: Word32 -> Word32
clearMsb Word32
x = forall a. Bits a => a -> Int -> a
clearBit Word32
x Int
31
  {-# INLINE clearMsb #-}

instance BinaryWord Word64 where
  type UnsignedWord Word64 = Word64
  type SignedWord Word64 = Int64
  unsignedWord :: Word64 -> UnsignedWord Word64
unsignedWord = forall a. a -> a
id
  {-# INLINE unsignedWord #-}
  signedWord :: Word64 -> SignedWord Word64
signedWord = forall a b. (Integral a, Num b) => a -> b
fromIntegral
  {-# INLINE signedWord #-}
#if __GLASGOW_HASKELL__ >= 705 && WORD_SIZE_IN_BITS == 64
  unwrappedAdd :: Word64 -> Word64 -> (Word64, UnsignedWord Word64)
unwrappedAdd (W64# Word#
x) (W64# Word#
y) = Word64
hi seq :: forall a b. a -> b -> b
`seq` Word64
lo seq :: forall a b. a -> b -> b
`seq` (Word64
hi, Word64
lo)
# if __GLASGOW_HASKELL__ >= 904
    where !(# hi', lo' #) = plusWord2# (word64ToWord# x) (word64ToWord# y)
          lo = W64# (wordToWord64# lo')
          hi = W64# (wordToWord64# hi')
# else
    where !(# Word#
hi', Word#
lo' #) = Word# -> Word# -> (# Word#, Word# #)
plusWord2# Word#
x Word#
y
          lo :: Word64
lo = Word# -> Word64
W64# Word#
lo'
          hi :: Word64
hi = Word# -> Word64
W64# Word#
hi'
# endif
  {-# INLINE unwrappedAdd #-}
#else
  unwrappedAdd x y = hi `seq` lo `seq` (hi, lo)
    where lo = x + y
          hi = if lo < x then 1 else 0
  {-# INLINABLE unwrappedAdd #-}
#endif
#if __GLASGOW_HASKELL__ >= 705 && WORD_SIZE_IN_BITS == 64
  unwrappedMul :: Word64 -> Word64 -> (Word64, UnsignedWord Word64)
unwrappedMul (W64# Word#
x) (W64# Word#
y) = Word64
hi seq :: forall a b. a -> b -> b
`seq` Word64
lo seq :: forall a b. a -> b -> b
`seq` (Word64
hi, Word64
lo)
# if __GLASGOW_HASKELL__ >= 904
    where !(# hi', lo' #) = timesWord2# (word64ToWord# x) (word64ToWord# y)
          lo = W64# (wordToWord64# lo')
          hi = W64# (wordToWord64# hi')
# else
    where !(# Word#
hi', Word#
lo' #) = Word# -> Word# -> (# Word#, Word# #)
timesWord2# Word#
x Word#
y
          lo :: Word64
lo = Word# -> Word64
W64# Word#
lo'
          hi :: Word64
hi = Word# -> Word64
W64# Word#
hi'
# endif
  {-# INLINE unwrappedMul #-}
#else
  unwrappedMul x y = hi `seq` lo `seq` (hi, lo)
    where xHi = shiftR x 32
          xLo = x .&. 0xFFFFFFFF
          yHi = shiftR y 32
          yLo = y .&. 0xFFFFFFFF
          hi0 = xHi * yHi
          lo0 = xLo * yLo
          p1  = xHi * yLo
          p2  = xLo * yHi
          hi  = hi0 + fromIntegral (uHi1 ∷ Word32) + fromIntegral uHi2 +
                shiftR p1 32 + shiftR p2 32
          lo  = shiftL (fromIntegral lo') 32 .|. (lo0 .&. 0xFFFFFFFF)
          (uHi1, uLo) = unwrappedAdd (fromIntegral p1) (fromIntegral p2)
          (uHi2, lo') = unwrappedAdd (fromIntegral (shiftR lo0 32)) uLo
#endif
#if MIN_VERSION_base(4,8,0)
  leadingZeroes :: Word64 -> Int
leadingZeroes = forall b. FiniteBits b => b -> Int
countLeadingZeros
  {-# INLINE leadingZeroes #-}
  trailingZeroes :: Word64 -> Int
trailingZeroes = forall b. FiniteBits b => b -> Int
countTrailingZeros
  {-# INLINE trailingZeroes #-}
#else
# if WORD_SIZE_IN_BITS == 64
  leadingZeroes w | w .&. 0xFFFFFFFF00000000 == 0 = go32 32 w
                  | otherwise                     = go32 0 (shiftR w 32)
    where
      go32 off w' | w' .&. 0xFFFF0000 == 0 = go16 (off + 16) w'
                  | otherwise              = go16 off (shiftR w' 16)
      go16 off w' | w' .&. 0xFF00 == 0     = go8 (off + 8) w'
                  | otherwise              = go8 off (shiftR w' 8)
      go8  off w' | w' .&. 0xF0 == 0       = go4 (off + 4) w'
                  | otherwise              = go4 off (shiftR w' 4)
      go4  off w' | w' .&. 8 /= 0          = off
                  | w' .&. 4 /= 0          = off + 1
                  | w' .&. 2 /= 0          = off + 2
                  | w' .&. 1 /= 0          = off + 3
                  | otherwise              = off + 4
  trailingZeroes w | w .&. 0x00000000FFFFFFFF == 0 = go32 32 (shiftR w 32)
                   | otherwise                     = go32 0 w
    where
      go32 off w' | w' .&. 0x0000FFFF == 0 = go16 (off + 16) (shiftR w' 16)
                  | otherwise              = go16 off w'
      go16 off w' | w' .&. 0x00FF == 0     = go8 (off + 8) (shiftR w' 8)
                  | otherwise              = go8 off w'
      go8  off w' | w' .&. 0x0F == 0       = go4 (off + 4) (shiftR w' 4)
                  | otherwise              = go4 off w'
      go4  off w' | w' .&. 1 /= 0          = off
                  | w' .&. 2 /= 0          = off + 1
                  | w' .&. 4 /= 0          = off + 2
                  | w' .&. 8 /= 0          = off + 3
                  | otherwise              = off + 4
# else
  leadingZeroes w | hiZeroes == 32 = 32 + leadingZeroes lo
                  | otherwise      = hiZeroes
    where lo = fromIntegral w ∷ Word32
          hi = fromIntegral (shiftR w 32) ∷ Word32
          hiZeroes = leadingZeroes hi
  trailingZeroes w | loZeroes == 32 = 32 + trailingZeroes hi
                   | otherwise      = loZeroes
    where lo = fromIntegral w ∷ Word32
          hi = fromIntegral (shiftR w 32) ∷ Word32
          loZeroes = trailingZeroes lo
# endif
#endif
  allZeroes :: Word64
allZeroes = Word64
0
  {-# INLINE allZeroes #-}
  allOnes :: Word64
allOnes = Word64
0xFFFFFFFFFFFFFFFF
  {-# INLINE allOnes #-}
  msb :: Word64
msb = Word64
0x8000000000000000
  {-# INLINE msb #-}
  lsb :: Word64
lsb = Word64
1
  {-# INLINE lsb #-}
  testMsb :: Word64 -> Bool
testMsb Word64
x = forall a. Bits a => a -> Int -> Bool
testBit Word64
x Int
63
  {-# INLINE testMsb #-}
  setMsb :: Word64 -> Word64
setMsb Word64
x = forall a. Bits a => a -> Int -> a
setBit Word64
x Int
63
  {-# INLINE setMsb #-}
  clearMsb :: Word64 -> Word64
clearMsb Word64
x = forall a. Bits a => a -> Int -> a
clearBit Word64
x Int
63
  {-# INLINE clearMsb #-}

instance BinaryWord Int8 where
  type UnsignedWord Int8 = Word8
  type SignedWord Int8 = Int8
  unsignedWord :: Int8 -> UnsignedWord Int8
unsignedWord = forall a b. (Integral a, Num b) => a -> b
fromIntegral
  {-# INLINE unsignedWord #-}
  signedWord :: Int8 -> SignedWord Int8
signedWord = forall a. a -> a
id
  {-# INLINE signedWord #-}
  unwrappedAdd :: Int8 -> Int8 -> (Int8, UnsignedWord Int8)
unwrappedAdd Int8
x Int8
y = Int8
hi seq :: forall a b. a -> b -> b
`seq` Word8
lo seq :: forall a b. a -> b -> b
`seq` (Int8
hi, Word8
lo)
    where s :: Int16
s = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int8
x forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int8
y ∷ Int16
          lo :: Word8
lo = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
s
          hi :: Int8
hi = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Int16
s Int
8)
  {-# INLINE unwrappedAdd #-}
  unwrappedMul :: Int8 -> Int8 -> (Int8, UnsignedWord Int8)
unwrappedMul Int8
x Int8
y = Int8
hi seq :: forall a b. a -> b -> b
`seq` Word8
lo seq :: forall a b. a -> b -> b
`seq` (Int8
hi, Word8
lo)
    where p :: Int16
p = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int8
x forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Int8
y ∷ Int16
          lo :: Word8
lo = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
p
          hi :: Int8
hi = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Int16
p Int
8)
  {-# INLINE unwrappedMul #-}
  leadingZeroes :: Int8 -> Int
leadingZeroes = forall w. BinaryWord w => w -> Int
leadingZeroes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w. BinaryWord w => w -> UnsignedWord w
unsignedWord
  {-# INLINE leadingZeroes #-}
  trailingZeroes :: Int8 -> Int
trailingZeroes = forall w. BinaryWord w => w -> Int
trailingZeroes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w. BinaryWord w => w -> UnsignedWord w
unsignedWord
  {-# INLINE trailingZeroes #-}
  allZeroes :: Int8
allZeroes = Int8
0
  {-# INLINE allZeroes #-}
  allOnes :: Int8
allOnes = -Int8
1
  {-# INLINE allOnes #-}
  msb :: Int8
msb = forall a. Bounded a => a
minBound
  {-# INLINE msb #-}
  lsb :: Int8
lsb = Int8
1
  {-# INLINE lsb #-}
  testMsb :: Int8 -> Bool
testMsb Int8
x = forall a. Bits a => a -> Int -> Bool
testBit Int8
x Int
7
  {-# INLINE testMsb #-}
  setMsb :: Int8 -> Int8
setMsb Int8
x = forall a. Bits a => a -> Int -> a
setBit Int8
x Int
7
  {-# INLINE setMsb #-}
  clearMsb :: Int8 -> Int8
clearMsb Int8
x = forall a. Bits a => a -> Int -> a
clearBit Int8
x Int
7
  {-# INLINE clearMsb #-}

instance BinaryWord Int16 where
  type UnsignedWord Int16 = Word16
  type SignedWord Int16 = Int16
  unsignedWord :: Int16 -> UnsignedWord Int16
unsignedWord = forall a b. (Integral a, Num b) => a -> b
fromIntegral
  {-# INLINE unsignedWord #-}
  signedWord :: Int16 -> SignedWord Int16
signedWord = forall a. a -> a
id
  {-# INLINE signedWord #-}
  unwrappedAdd :: Int16 -> Int16 -> (Int16, UnsignedWord Int16)
unwrappedAdd Int16
x Int16
y = Int16
hi seq :: forall a b. a -> b -> b
`seq` Word16
lo seq :: forall a b. a -> b -> b
`seq` (Int16
hi, Word16
lo)
    where s :: Int32
s  = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
x forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
y ∷ Int32
          lo :: Word16
lo = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
s
          hi :: Int16
hi = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Int32
s Int
16)
  {-# INLINE unwrappedAdd #-}
  unwrappedMul :: Int16 -> Int16 -> (Int16, UnsignedWord Int16)
unwrappedMul Int16
x Int16
y = Int16
hi seq :: forall a b. a -> b -> b
`seq` Word16
lo seq :: forall a b. a -> b -> b
`seq` (Int16
hi, Word16
lo)
    where p :: Int32
p  = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
x forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
y ∷ Int32
          lo :: Word16
lo = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
p
          hi :: Int16
hi = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Int32
p Int
16)
  {-# INLINE unwrappedMul #-}
  leadingZeroes :: Int16 -> Int
leadingZeroes = forall w. BinaryWord w => w -> Int
leadingZeroes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w. BinaryWord w => w -> UnsignedWord w
unsignedWord
  {-# INLINE leadingZeroes #-}
  trailingZeroes :: Int16 -> Int
trailingZeroes = forall w. BinaryWord w => w -> Int
trailingZeroes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w. BinaryWord w => w -> UnsignedWord w
unsignedWord
  {-# INLINE trailingZeroes #-}
  allZeroes :: Int16
allZeroes = Int16
0
  {-# INLINE allZeroes #-}
  allOnes :: Int16
allOnes = -Int16
1
  {-# INLINE allOnes #-}
  msb :: Int16
msb = forall a. Bounded a => a
minBound
  {-# INLINE msb #-}
  lsb :: Int16
lsb = Int16
1
  {-# INLINE lsb #-}
  testMsb :: Int16 -> Bool
testMsb Int16
x = forall a. Bits a => a -> Int -> Bool
testBit Int16
x Int
15
  {-# INLINE testMsb #-}
  setMsb :: Int16 -> Int16
setMsb Int16
x = forall a. Bits a => a -> Int -> a
setBit Int16
x Int
15
  {-# INLINE setMsb #-}
  clearMsb :: Int16 -> Int16
clearMsb Int16
x = forall a. Bits a => a -> Int -> a
clearBit Int16
x Int
15
  {-# INLINE clearMsb #-}

instance BinaryWord Int32 where
  type UnsignedWord Int32 = Word32
  type SignedWord Int32 = Int32
  unsignedWord :: Int32 -> UnsignedWord Int32
unsignedWord = forall a b. (Integral a, Num b) => a -> b
fromIntegral
  {-# INLINE unsignedWord #-}
  signedWord :: Int32 -> SignedWord Int32
signedWord = forall a. a -> a
id
  {-# INLINE signedWord #-}
#if WORD_SIZE_IN_BITS == 32
  unwrappedAdd x y = hi `seq` lo `seq` (hi, lo)
    where extX = if x < 0 then maxBound else 0
          extY = if y < 0 then maxBound else 0
          (hi', lo) = unsignedWord x `unwrappedAdd` unsignedWord y
          hi = signedWord $ hi' + extX + extY
  unwrappedMul x y = hi `seq` lo `seq` (hi, lo)
    where extX = if x < 0 then negate y else 0
          extY = if y < 0 then negate x else 0
          (hi', lo) = unsignedWord x `unwrappedMul` unsignedWord y
          hi = signedWord hi' + extX + extY
#else
  unwrappedAdd :: Int32 -> Int32 -> (Int32, UnsignedWord Int32)
unwrappedAdd Int32
x Int32
y = Int32
hi seq :: forall a b. a -> b -> b
`seq` Word32
lo seq :: forall a b. a -> b -> b
`seq` (Int32
hi, Word32
lo)
    where s :: Int64
s  = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
x forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
y ∷ Int64
          lo :: Word32
lo = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
s
          hi :: Int32
hi = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Int64
s Int
32)
  {-# INLINE unwrappedAdd #-}
  unwrappedMul :: Int32 -> Int32 -> (Int32, UnsignedWord Int32)
unwrappedMul Int32
x Int32
y = Int32
hi seq :: forall a b. a -> b -> b
`seq` Word32
lo seq :: forall a b. a -> b -> b
`seq` (Int32
hi, Word32
lo)
    where p :: Int64
p  = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
x forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
y ∷ Int64
          lo :: Word32
lo = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
p
          hi :: Int32
hi = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Int64
p Int
32)
  {-# INLINE unwrappedMul #-}
#endif
  leadingZeroes :: Int32 -> Int
leadingZeroes = forall w. BinaryWord w => w -> Int
leadingZeroes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w. BinaryWord w => w -> UnsignedWord w
unsignedWord
  {-# INLINE leadingZeroes #-}
  trailingZeroes :: Int32 -> Int
trailingZeroes = forall w. BinaryWord w => w -> Int
trailingZeroes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w. BinaryWord w => w -> UnsignedWord w
unsignedWord
  {-# INLINE trailingZeroes #-}
  allZeroes :: Int32
allZeroes = Int32
0
  {-# INLINE allZeroes #-}
  allOnes :: Int32
allOnes = -Int32
1
  {-# INLINE allOnes #-}
  msb :: Int32
msb = forall a. Bounded a => a
minBound
  {-# INLINE msb #-}
  lsb :: Int32
lsb = Int32
1
  {-# INLINE lsb #-}
  testMsb :: Int32 -> Bool
testMsb Int32
x = forall a. Bits a => a -> Int -> Bool
testBit Int32
x Int
31
  {-# INLINE testMsb #-}
  setMsb :: Int32 -> Int32
setMsb Int32
x = forall a. Bits a => a -> Int -> a
setBit Int32
x Int
31
  {-# INLINE setMsb #-}
  clearMsb :: Int32 -> Int32
clearMsb Int32
x = forall a. Bits a => a -> Int -> a
clearBit Int32
x Int
31
  {-# INLINE clearMsb #-}

instance BinaryWord Int64 where
  type UnsignedWord Int64 = Word64
  type SignedWord Int64 = Int64
  unsignedWord :: Int64 -> UnsignedWord Int64
unsignedWord = forall a b. (Integral a, Num b) => a -> b
fromIntegral
  {-# INLINE unsignedWord #-}
  signedWord :: Int64 -> SignedWord Int64
signedWord = forall a. a -> a
id
  {-# INLINE signedWord #-}
  unwrappedAdd :: Int64 -> Int64 -> (Int64, UnsignedWord Int64)
unwrappedAdd Int64
x Int64
y = SignedWord Word64
hi seq :: forall a b. a -> b -> b
`seq` UnsignedWord Word64
lo seq :: forall a b. a -> b -> b
`seq` (SignedWord Word64
hi, UnsignedWord Word64
lo)
    where extX :: Word64
extX = if Int64
x forall a. Ord a => a -> a -> Bool
< Int64
0 then forall a. Bounded a => a
maxBound else Word64
0
          extY :: Word64
extY = if Int64
y forall a. Ord a => a -> a -> Bool
< Int64
0 then forall a. Bounded a => a
maxBound else Word64
0
          (Word64
hi', UnsignedWord Word64
lo) = forall w. BinaryWord w => w -> UnsignedWord w
unsignedWord Int64
x forall w. BinaryWord w => w -> w -> (w, UnsignedWord w)
`unwrappedAdd` forall w. BinaryWord w => w -> UnsignedWord w
unsignedWord Int64
y
          hi :: SignedWord Word64
hi = forall w. BinaryWord w => w -> SignedWord w
signedWord forall a b. (a -> b) -> a -> b
$ Word64
hi' forall a. Num a => a -> a -> a
+ Word64
extX forall a. Num a => a -> a -> a
+ Word64
extY
  unwrappedMul :: Int64 -> Int64 -> (Int64, UnsignedWord Int64)
unwrappedMul Int64
x Int64
y = Int64
hi seq :: forall a b. a -> b -> b
`seq` UnsignedWord Word64
lo seq :: forall a b. a -> b -> b
`seq` (Int64
hi, UnsignedWord Word64
lo)
    where extX :: Int64
extX = if Int64
x forall a. Ord a => a -> a -> Bool
< Int64
0 then forall a. Num a => a -> a
negate Int64
y else Int64
0
          extY :: Int64
extY = if Int64
y forall a. Ord a => a -> a -> Bool
< Int64
0 then forall a. Num a => a -> a
negate Int64
x else Int64
0
          (Word64
hi', UnsignedWord Word64
lo) = forall w. BinaryWord w => w -> UnsignedWord w
unsignedWord Int64
x forall w. BinaryWord w => w -> w -> (w, UnsignedWord w)
`unwrappedMul` forall w. BinaryWord w => w -> UnsignedWord w
unsignedWord Int64
y
          hi :: Int64
hi = forall w. BinaryWord w => w -> SignedWord w
signedWord Word64
hi' forall a. Num a => a -> a -> a
+ Int64
extX forall a. Num a => a -> a -> a
+ Int64
extY
  leadingZeroes :: Int64 -> Int
leadingZeroes = forall w. BinaryWord w => w -> Int
leadingZeroes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w. BinaryWord w => w -> UnsignedWord w
unsignedWord
  {-# INLINE leadingZeroes #-}
  trailingZeroes :: Int64 -> Int
trailingZeroes = forall w. BinaryWord w => w -> Int
trailingZeroes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w. BinaryWord w => w -> UnsignedWord w
unsignedWord
  {-# INLINE trailingZeroes #-}
  allZeroes :: Int64
allZeroes = Int64
0
  {-# INLINE allZeroes #-}
  allOnes :: Int64
allOnes = -Int64
1
  {-# INLINE allOnes #-}
  msb :: Int64
msb = forall a. Bounded a => a
minBound
  {-# INLINE msb #-}
  lsb :: Int64
lsb = Int64
1
  {-# INLINE lsb #-}
  testMsb :: Int64 -> Bool
testMsb Int64
x = forall a. Bits a => a -> Int -> Bool
testBit Int64
x Int
63
  {-# INLINE testMsb #-}
  setMsb :: Int64 -> Int64
setMsb Int64
x = forall a. Bits a => a -> Int -> a
setBit Int64
x Int
63
  {-# INLINE setMsb #-}
  clearMsb :: Int64 -> Int64
clearMsb Int64
x = forall a. Bits a => a -> Int -> a
clearBit Int64
x Int
63
  {-# INLINE clearMsb #-}