{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -funbox-strict-fields #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Data.WideWord.Word64
--
-- Maintainer  :  erikd@mega-nerd.com
-- Stability   :  experimental
-- Portability :  non-portable (GHC extensions and primops)
--
-- This module provides an opaque unsigned 64 bit value with the usual set
-- of typeclass instances one would expect for a fixed width unsigned integer
-- type.
-- Operations like addition, subtraction and multiplication etc provide a
-- "modulo 2^64" result as one would expect from a fixed width unsigned word.
--
-- This just re-exports the Word64 type defined in Data.Word plus some functions
-- like plusCarrySum and timesCarryProd that do the normal addition and multiplication
-- but provide a carry in addition to the regular operation.
-------------------------------------------------------------------------------

#include <MachDeps.h>

module Data.WideWord.Word64
  ( mkWord64
  , oneWord64
  , plusCarrySum
  , quotRem2Word64
  , showHexWord64
  , subCarryDiff
  , timesCarryProd
  , word64Hi32
  , word64Lo32
  , zeroWord64
  ) where

import Data.Bits (shiftL, shiftR)

#if WORD_SIZE_IN_BITS == 32
import GHC.Exts (Word#, Word64#, uncheckedShiftRL64#, word64ToWord#)
#else
import Data.WideWord.Compat
#endif

import GHC.Word (Word32 (..), Word64 (..))

import Numeric (showHex)

{-# INLINE mkWord64 #-}
mkWord64 :: Word32 -> Word32 -> Word64
mkWord64 :: Word32 -> Word32 -> Word64
mkWord64 Word32
hi Word32
lo = Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
hi Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
32 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
lo

{-# INLINE showHexWord64 #-}
showHexWord64 :: Word64 -> String
showHexWord64 :: Word64 -> String
showHexWord64 Word64
w = Word64 -> ShowS
forall a. Integral a => a -> ShowS
showHex Word64
w String
""

{-# INLINE word64Hi32 #-}
word64Hi32 :: Word64 -> Word32
word64Hi32 :: Word64 -> Word32
word64Hi32 Word64
w = Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
32)

{-# INLINE word64Lo32 #-}
word64Lo32 :: Word64 -> Word32
word64Lo32 :: Word64 -> Word32
word64Lo32 = Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral

{-# INLINE oneWord64 #-}
oneWord64 :: Word64
oneWord64 :: Word64
oneWord64 = Word64
1

{-# INLINE zeroWord64 #-}
zeroWord64 :: Word64
zeroWord64 :: Word64
zeroWord64 = Word64
0

#if WORD_SIZE_IN_BITS == 64

{-# INLINE plusCarrySum #-}
plusCarrySum :: Word64 -> Word64 -> (Word64, Word64)
plusCarrySum :: Word64 -> Word64 -> (Word64, Word64)
plusCarrySum (W64# Word64#
a) (W64# Word64#
b) =
  let !(# Word64#
c, Word64#
s #) = Word64# -> Word64# -> (# Word64#, Word64# #)
plusWord2# Word64#
a Word64#
b
   in (Word64# -> Word64
W64# Word64#
c, Word64# -> Word64
W64# Word64#
s)

quotRem2Word64 :: Word64 -> Word64 -> Word64 -> (Word64, Word64)
quotRem2Word64 :: Word64 -> Word64 -> Word64 -> (Word64, Word64)
quotRem2Word64 (W64# Word64#
n1) (W64# Word64#
n0) (W64# Word64#
d) =
  case Word64# -> Word64# -> Word64# -> (# Word64#, Word64# #)
quotRemWord2# Word64#
n1 Word64#
n0 Word64#
d of
    (# Word64#
q, Word64#
r #) -> (Word64# -> Word64
W64# Word64#
q, Word64# -> Word64
W64# Word64#
r)

{-# INLINE subCarryDiff #-}
subCarryDiff :: Word64 -> Word64 -> (Word64, Word64)
subCarryDiff :: Word64 -> Word64 -> (Word64, Word64)
subCarryDiff (W64# Word64#
a) (W64# Word64#
b) =
  let !(# Word64#
d, Int64#
c #) = Word64# -> Word64# -> (# Word64#, Int64# #)
subWordC# Word64#
a Word64#
b
   in (Word64# -> Word64
W64# (Int64# -> Word64#
int2Word# Int64#
c), Word64# -> Word64
W64# Word64#
d)

{-# INLINE timesCarryProd #-}
timesCarryProd :: Word64 -> Word64 -> (Word64, Word64)
timesCarryProd :: Word64 -> Word64 -> (Word64, Word64)
timesCarryProd (W64# Word64#
a) (W64# Word64#
b) =
  let !(# Word64#
c, Word64#
s #) = Word64# -> Word64# -> (# Word64#, Word64# #)
timesWord2# Word64#
a Word64#
b
   in (Word64# -> Word64
W64# Word64#
c, Word64# -> Word64
W64# Word64#
s)

#elif  WORD_SIZE_IN_BITS == 32

{-# INLINE plusCarrySum #-}
plusCarrySum :: Word64 -> Word64 -> (Word64, Word64)
plusCarrySum a b = (if ab < a then 1 else 0, ab)
  where
    ab = a + b

quotRem2Word64 :: Word64 -> Word64 -> Word64 -> (Word64, Word64)
quotRem2Word64 n1 n0 d =
  -- This is correct, but sub-optimal and I could not be bothered writing an
  -- optimal version that is only needed for 32 bit systems.
  case quotRem (toInteger n1 `shiftL` 64 + toInteger n0) (toInteger d) of
    (q, r) -> (fromInteger q, fromInteger r)

{-# INLINE subCarryDiff #-}
subCarryDiff :: Word64 -> Word64 -> (Word64, Word64)
subCarryDiff a b = (if ab > a then 1 else 0, ab)
  where
    ab = a - b

pattern W64 :: Word32 -> Word32 -> Word64
pattern W64 hi lo <- ((\x -> (word64Hi32 x, word64Lo32 x)) -> (hi, lo))
  where
    W64 hi lo = mkWord64 hi lo
{-# COMPLETE W64 #-}

{-# INLINE timesCarryProd #-}
timesCarryProd :: Word64 -> Word64 -> (Word64, Word64)
timesCarryProd (W64 a1 a0) (W64 b1 b0) = (W64 p3 p2, W64 p1 p0)
  where
    W64 c00 p00 = fromIntegral a0 * fromIntegral b0
    W64 c01 p01 = fromIntegral a0 * fromIntegral b1
    W64 c10 p10 = fromIntegral a1 * fromIntegral b0
    W64 c11 p11 = fromIntegral a1 * fromIntegral b1

    p0 = p00
    W64 c1 p1 = fromIntegral c00 + fromIntegral p01 + fromIntegral p10
    W64 c2 p2 = fromIntegral c01 + fromIntegral c10 + fromIntegral p11 + fromIntegral c1
    p3 = c11 + c2

#else

error "Sorry, this package only supports 32 and 64 bit word sizes."

#endif