{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE Unsafe #-}
{-# OPTIONS_HADDOCK not-home #-}
module GHC.Natural
    ( 
      
      
      
      
      Natural(..)
    , isValidNatural
      
    , naturalFromInteger
    , wordToNatural
    , naturalToWordMaybe
      
    , minusNaturalMaybe
      
    , powModNatural
    ) where
#include "MachDeps.h"
import GHC.Arr
import GHC.Base
import {-# SOURCE #-} GHC.Exception (underflowException)
#if defined(MIN_VERSION_integer_gmp)
import GHC.Integer.GMP.Internals
import Data.Word
import Data.Int
#endif
import GHC.Num
import GHC.Real
import GHC.Read
import GHC.Show
import GHC.Enum
import GHC.List
import Data.Bits
default ()
{-# NOINLINE underflowError #-}
underflowError :: a
underflowError = raise# underflowException
#if defined(MIN_VERSION_integer_gmp)
data Natural = NatS#                 GmpLimb# 
             | NatJ# {-# UNPACK #-} !BigNat   
                                              
                                              
                                              
                                              
             deriving (Eq,Ord) 
                               
isValidNatural :: Natural -> Bool
isValidNatural (NatS# _)  = True
isValidNatural (NatJ# bn) = isTrue# (isValidBigNat# bn)
                            && I# (sizeofBigNat# bn) > 0
{-# RULES
"fromIntegral/Natural->Natural"  fromIntegral = id :: Natural -> Natural
"fromIntegral/Natural->Integer"  fromIntegral = toInteger :: Natural->Integer
"fromIntegral/Natural->Word"     fromIntegral = naturalToWord
"fromIntegral/Natural->Word8"
    fromIntegral = (fromIntegral :: Word -> Word8)  . naturalToWord
"fromIntegral/Natural->Word16"
    fromIntegral = (fromIntegral :: Word -> Word16) . naturalToWord
"fromIntegral/Natural->Word32"
    fromIntegral = (fromIntegral :: Word -> Word32) . naturalToWord
"fromIntegral/Natural->Int8"
    fromIntegral = (fromIntegral :: Int -> Int8)    . naturalToInt
"fromIntegral/Natural->Int16"
    fromIntegral = (fromIntegral :: Int -> Int16)   . naturalToInt
"fromIntegral/Natural->Int32"
    fromIntegral = (fromIntegral :: Int -> Int32)   . naturalToInt
  #-}
{-# RULES
"fromIntegral/Word->Natural"     fromIntegral = wordToNatural
"fromIntegral/Word8->Natural"
    fromIntegral = wordToNatural . (fromIntegral :: Word8  -> Word)
"fromIntegral/Word16->Natural"
    fromIntegral = wordToNatural . (fromIntegral :: Word16 -> Word)
"fromIntegral/Word32->Natural"
    fromIntegral = wordToNatural . (fromIntegral :: Word32 -> Word)
"fromIntegral/Int->Natural"     fromIntegral = intToNatural
"fromIntegral/Int8->Natural"
    fromIntegral = intToNatural  . (fromIntegral :: Int8  -> Int)
"fromIntegral/Int16->Natural"
    fromIntegral = intToNatural  . (fromIntegral :: Int16 -> Int)
"fromIntegral/Int32->Natural"
    fromIntegral = intToNatural  . (fromIntegral :: Int32 -> Int)
  #-}
#if WORD_SIZE_IN_BITS == 64
{-# RULES
"fromIntegral/Natural->Word64"
    fromIntegral = (fromIntegral :: Word -> Word64) . naturalToWord
"fromIntegral/Natural->Int64"
    fromIntegral = (fromIntegral :: Int -> Int64) . naturalToInt
"fromIntegral/Word64->Natural"
    fromIntegral = wordToNatural . (fromIntegral :: Word64 -> Word)
"fromIntegral/Int64->Natural"
    fromIntegral = intToNatural . (fromIntegral :: Int64 -> Int)
  #-}
#endif
instance Show Natural where
    showsPrec p (NatS# w#)  = showsPrec p (W# w#)
    showsPrec p (NatJ# bn)  = showsPrec p (Jp# bn)
instance Read Natural where
    readsPrec d = map (\(n, s) -> (fromInteger n, s))
                  . filter ((>= 0) . (\(x,_)->x)) . readsPrec d
instance Num Natural where
    fromInteger          = naturalFromInteger
    (+) = plusNatural
    (*) = timesNatural
    (-) = minusNatural
    abs                  = id
    signum (NatS# 0##)   = NatS# 0##
    signum _             = NatS# 1##
    negate (NatS# 0##)   = NatS# 0##
    negate _             = underflowError
naturalFromInteger :: Integer -> Natural
naturalFromInteger (S# i#) | I# i# >= 0  = NatS# (int2Word# i#)
naturalFromInteger (Jp# bn)              = bigNatToNatural bn
naturalFromInteger _                     = underflowError
{-# INLINE naturalFromInteger #-}
instance Real Natural where
    toRational (NatS# w)  = toRational (W# w)
    toRational (NatJ# bn) = toRational (Jp# bn)
#if OPTIMISE_INTEGER_GCD_LCM
{-# RULES
"gcd/Natural->Natural->Natural" gcd = gcdNatural
"lcm/Natural->Natural->Natural" lcm = lcmNatural
  #-}
gcdNatural :: Natural -> Natural -> Natural
gcdNatural (NatS# 0##) y       = y
gcdNatural x       (NatS# 0##) = x
gcdNatural (NatS# 1##) _       = (NatS# 1##)
gcdNatural _       (NatS# 1##) = (NatS# 1##)
gcdNatural (NatJ# x) (NatJ# y) = bigNatToNatural (gcdBigNat x y)
gcdNatural (NatJ# x) (NatS# y) = NatS# (gcdBigNatWord x y)
gcdNatural (NatS# x) (NatJ# y) = NatS# (gcdBigNatWord y x)
gcdNatural (NatS# x) (NatS# y) = NatS# (gcdWord x y)
lcmNatural :: Natural -> Natural -> Natural
lcmNatural (NatS# 0##) _ = (NatS# 0##)
lcmNatural _ (NatS# 0##) = (NatS# 0##)
lcmNatural (NatS# 1##) y = y
lcmNatural x (NatS# 1##) = x
lcmNatural x y           = (x `quot` (gcdNatural x y)) * y
#endif
instance Enum Natural where
    succ n = n `plusNatural`  NatS# 1##
    pred n = n `minusNatural` NatS# 1##
    toEnum = intToNatural
    fromEnum (NatS# w) | i >= 0 = i
      where
        i = fromIntegral (W# w)
    fromEnum _ = errorWithoutStackTrace "fromEnum: out of Int range"
    enumFrom x        = enumDeltaNatural      x (NatS# 1##)
    enumFromThen x y
      | x <= y        = enumDeltaNatural      x (y-x)
      | otherwise     = enumNegDeltaToNatural x (x-y) (NatS# 0##)
    enumFromTo x lim  = enumDeltaToNatural    x (NatS# 1##) lim
    enumFromThenTo x y lim
      | x <= y        = enumDeltaToNatural    x (y-x) lim
      | otherwise     = enumNegDeltaToNatural x (x-y) lim
enumDeltaNatural :: Natural -> Natural -> [Natural]
enumDeltaNatural !x d = x : enumDeltaNatural (x+d) d
enumDeltaToNatural :: Natural -> Natural -> Natural -> [Natural]
enumDeltaToNatural x0 delta lim = go x0
  where
    go x | x > lim   = []
         | otherwise = x : go (x+delta)
enumNegDeltaToNatural :: Natural -> Natural -> Natural -> [Natural]
enumNegDeltaToNatural x0 ndelta lim = go x0
  where
    go x | x < lim     = []
         | x >= ndelta = x : go (x-ndelta)
         | otherwise   = [x]
instance Integral Natural where
    toInteger (NatS# w)  = wordToInteger w
    toInteger (NatJ# bn) = Jp# bn
    divMod = quotRem
    div    = quot
    mod    = rem
    quotRem _ (NatS# 0##) = divZeroError
    quotRem n (NatS# 1##) = (n,NatS# 0##)
    quotRem n@(NatS# _) (NatJ# _) = (NatS# 0##, n)
    quotRem (NatS# n) (NatS# d) = case quotRem (W# n) (W# d) of
        (q,r) -> (wordToNatural q, wordToNatural r)
    quotRem (NatJ# n) (NatS# d) = case quotRemBigNatWord n d of
        (# q,r #) -> (bigNatToNatural q, NatS# r)
    quotRem (NatJ# n) (NatJ# d) = case quotRemBigNat n d of
        (# q,r #) -> (bigNatToNatural q, bigNatToNatural r)
    quot _       (NatS# 0##) = divZeroError
    quot n       (NatS# 1##) = n
    quot (NatS# _) (NatJ# _) = NatS# 0##
    quot (NatS# n) (NatS# d) = wordToNatural (quot (W# n) (W# d))
    quot (NatJ# n) (NatS# d) = bigNatToNatural (quotBigNatWord n d)
    quot (NatJ# n) (NatJ# d) = bigNatToNatural (quotBigNat n d)
    rem _         (NatS# 0##) = divZeroError
    rem _         (NatS# 1##) = NatS# 0##
    rem n@(NatS# _) (NatJ# _) = n
    rem   (NatS# n) (NatS# d) = wordToNatural (rem (W# n) (W# d))
    rem   (NatJ# n) (NatS# d) = NatS# (remBigNatWord n d)
    rem   (NatJ# n) (NatJ# d) = bigNatToNatural (remBigNat n d)
instance Ix Natural where
    range (m,n) = [m..n]
    inRange (m,n) i = m <= i && i <= n
    unsafeIndex (m,_) i = fromIntegral (i-m)
    index b i | inRange b i = unsafeIndex b i
              | otherwise   = indexError b i "Natural"
instance Bits Natural where
    NatS# n .&. NatS# m = wordToNatural (W# n .&. W# m)
    NatS# n .&. NatJ# m = wordToNatural (W# n .&. W# (bigNatToWord m))
    NatJ# n .&. NatS# m = wordToNatural (W# (bigNatToWord n) .&. W# m)
    NatJ# n .&. NatJ# m = bigNatToNatural (andBigNat n m)
    NatS# n .|. NatS# m = wordToNatural (W# n .|. W# m)
    NatS# n .|. NatJ# m = NatJ# (orBigNat (wordToBigNat n) m)
    NatJ# n .|. NatS# m = NatJ# (orBigNat n (wordToBigNat m))
    NatJ# n .|. NatJ# m = NatJ# (orBigNat n m)
    NatS# n `xor` NatS# m = wordToNatural (W# n `xor` W# m)
    NatS# n `xor` NatJ# m = NatJ# (xorBigNat (wordToBigNat n) m)
    NatJ# n `xor` NatS# m = NatJ# (xorBigNat n (wordToBigNat m))
    NatJ# n `xor` NatJ# m = bigNatToNatural (xorBigNat n m)
    complement _ = errorWithoutStackTrace "Bits.complement: Natural complement undefined"
    bitSizeMaybe _ = Nothing
    bitSize = errorWithoutStackTrace "Natural: bitSize"
    isSigned _ = False
    bit i@(I# i#) | i < finiteBitSize (0::Word) = wordToNatural (bit i)
                  | otherwise                   = NatJ# (bitBigNat i#)
    testBit (NatS# w) i = testBit (W# w) i
    testBit (NatJ# bn) (I# i#) = testBitBigNat bn i#
    clearBit n@(NatS# w#) i
        | i < finiteBitSize (0::Word) = let !(W# w2#) = clearBit (W# w#) i in NatS# w2#
        | otherwise                   = n
    clearBit (NatJ# bn) (I# i#) = bigNatToNatural (clearBitBigNat bn i#)
    setBit (NatS# w#) i@(I# i#)
        | i < finiteBitSize (0::Word) = let !(W# w2#) = setBit (W# w#) i in NatS# w2#
        | otherwise                   = bigNatToNatural (setBitBigNat (wordToBigNat w#) i#)
    setBit (NatJ# bn) (I# i#) = bigNatToNatural (setBitBigNat bn i#)
    complementBit (NatS# w#) i@(I# i#)
        | i < finiteBitSize (0::Word) = let !(W# w2#) = complementBit (W# w#) i in NatS# w2#
        | otherwise                   = bigNatToNatural (setBitBigNat (wordToBigNat w#) i#)
    complementBit (NatJ# bn) (I# i#) = bigNatToNatural (complementBitBigNat bn i#)
    shiftL n           0 = n
    shiftL (NatS# 0##) _ = NatS# 0##
    shiftL (NatS# 1##) i = bit i
    shiftL (NatS# w) (I# i#)
        = bigNatToNatural $ shiftLBigNat (wordToBigNat w) i#
    shiftL (NatJ# bn) (I# i#)
        = bigNatToNatural $ shiftLBigNat bn i#
    shiftR n          0       = n
    shiftR (NatS# w)  i       = wordToNatural $ shiftR (W# w) i
    shiftR (NatJ# bn) (I# i#) = bigNatToNatural (shiftRBigNat bn i#)
    rotateL = shiftL
    rotateR = shiftR
    popCount (NatS# w)  = popCount (W# w)
    popCount (NatJ# bn) = I# (popCountBigNat bn)
    zeroBits = NatS# 0##
plusNatural :: Natural -> Natural -> Natural
plusNatural (NatS# 0##) y         = y
plusNatural x         (NatS# 0##) = x
plusNatural (NatS# x) (NatS# y)
    = case plusWord2# x y of
       (# 0##, l #) -> NatS# l
       (# h,   l #) -> NatJ# (wordToBigNat2 h l)
plusNatural (NatS# x) (NatJ# y) = NatJ# (plusBigNatWord y x)
plusNatural (NatJ# x) (NatS# y) = NatJ# (plusBigNatWord x y)
plusNatural (NatJ# x) (NatJ# y) = NatJ# (plusBigNat     x y)
timesNatural :: Natural -> Natural -> Natural
timesNatural _         (NatS# 0##) = NatS# 0##
timesNatural (NatS# 0##) _         = NatS# 0##
timesNatural x         (NatS# 1##) = x
timesNatural (NatS# 1##) y         = y
timesNatural (NatS# x) (NatS# y) = case timesWord2# x y of
    (# 0##, 0## #) -> NatS# 0##
    (# 0##, xy  #) -> NatS# xy
    (# h  , l   #) -> NatJ# $ wordToBigNat2 h l
timesNatural (NatS# x) (NatJ# y) = NatJ# $ timesBigNatWord y x
timesNatural (NatJ# x) (NatS# y) = NatJ# $ timesBigNatWord x y
timesNatural (NatJ# x) (NatJ# y) = NatJ# $ timesBigNat     x y
minusNatural :: Natural -> Natural -> Natural
minusNatural x         (NatS# 0##) = x
minusNatural (NatS# x) (NatS# y) = case subWordC# x y of
    (# l, 0# #) -> NatS# l
    _           -> underflowError
minusNatural (NatS# _) (NatJ# _) = underflowError
minusNatural (NatJ# x) (NatS# y)
    = bigNatToNatural $ minusBigNatWord x y
minusNatural (NatJ# x) (NatJ# y)
    = bigNatToNatural $ minusBigNat     x y
minusNaturalMaybe :: Natural -> Natural -> Maybe Natural
minusNaturalMaybe x         (NatS# 0##) = Just x
minusNaturalMaybe (NatS# x) (NatS# y) = case subWordC# x y of
    (# l, 0# #) -> Just (NatS# l)
    _           -> Nothing
  where
minusNaturalMaybe (NatS# _) (NatJ# _) = Nothing
minusNaturalMaybe (NatJ# x) (NatS# y)
    = Just $ bigNatToNatural $ minusBigNatWord x y
minusNaturalMaybe (NatJ# x) (NatJ# y)
  | isTrue# (isNullBigNat# res) = Nothing
  | otherwise = Just (bigNatToNatural res)
  where
    res = minusBigNat x y
bigNatToNatural :: BigNat -> Natural
bigNatToNatural bn
  | isTrue# (sizeofBigNat# bn ==# 1#) = NatS# (bigNatToWord bn)
  | isTrue# (isNullBigNat# bn)        = underflowError
  | otherwise                         = NatJ# bn
naturalToBigNat :: Natural -> BigNat
naturalToBigNat (NatS# w#) = wordToBigNat w#
naturalToBigNat (NatJ# bn) = bn
intToNatural :: Int -> Natural
intToNatural i | i<0 = underflowError
intToNatural (I# i#) = NatS# (int2Word# i#)
naturalToWord :: Natural -> Word
naturalToWord (NatS# w#) = W# w#
naturalToWord (NatJ# bn) = W# (bigNatToWord bn)
naturalToInt :: Natural -> Int
naturalToInt (NatS# w#) = I# (word2Int# w#)
naturalToInt (NatJ# bn) = I# (bigNatToInt bn)
#else /* !defined(MIN_VERSION_integer_gmp) */
newtype Natural = Natural Integer 
                deriving (Eq,Ord,Ix)
isValidNatural :: Natural -> Bool
isValidNatural (Natural i) = i >= 0
instance Read Natural where
    readsPrec d = map (\(n, s) -> (Natural n, s))
                  . filter ((>= 0) . (\(x,_)->x)) . readsPrec d
instance Show Natural where
    showsPrec d (Natural i) = showsPrec d i
instance Num Natural where
  Natural n + Natural m = Natural (n + m)
  {-# INLINE (+) #-}
  Natural n * Natural m = Natural (n * m)
  {-# INLINE (*) #-}
  Natural n - Natural m | result < 0 = underflowError
                        | otherwise  = Natural result
    where result = n - m
  {-# INLINE (-) #-}
  abs (Natural n) = Natural n
  {-# INLINE abs #-}
  signum (Natural n) = Natural (signum n)
  {-# INLINE signum #-}
  fromInteger = naturalFromInteger
  {-# INLINE fromInteger #-}
naturalFromInteger :: Integer -> Natural
naturalFromInteger n
  | n >= 0 = Natural n
  | otherwise = underflowError
{-# INLINE naturalFromInteger #-}
minusNaturalMaybe :: Natural -> Natural -> Maybe Natural
minusNaturalMaybe x y
  | x >= y    = Just (x - y)
  | otherwise = Nothing
instance Bits Natural where
  Natural n .&. Natural m = Natural (n .&. m)
  {-# INLINE (.&.) #-}
  Natural n .|. Natural m = Natural (n .|. m)
  {-# INLINE (.|.) #-}
  xor (Natural n) (Natural m) = Natural (xor n m)
  {-# INLINE xor #-}
  complement _ = errorWithoutStackTrace "Bits.complement: Natural complement undefined"
  {-# INLINE complement #-}
  shift (Natural n) = Natural . shift n
  {-# INLINE shift #-}
  rotate (Natural n) = Natural . rotate n
  {-# INLINE rotate #-}
  bit = Natural . bit
  {-# INLINE bit #-}
  setBit (Natural n) = Natural . setBit n
  {-# INLINE setBit #-}
  clearBit (Natural n) = Natural . clearBit n
  {-# INLINE clearBit #-}
  complementBit (Natural n) = Natural . complementBit n
  {-# INLINE complementBit #-}
  testBit (Natural n) = testBit n
  {-# INLINE testBit #-}
  bitSizeMaybe _ = Nothing
  {-# INLINE bitSizeMaybe #-}
  bitSize = errorWithoutStackTrace "Natural: bitSize"
  {-# INLINE bitSize #-}
  isSigned _ = False
  {-# INLINE isSigned #-}
  shiftL (Natural n) = Natural . shiftL n
  {-# INLINE shiftL #-}
  shiftR (Natural n) = Natural . shiftR n
  {-# INLINE shiftR #-}
  rotateL (Natural n) = Natural . rotateL n
  {-# INLINE rotateL #-}
  rotateR (Natural n) = Natural . rotateR n
  {-# INLINE rotateR #-}
  popCount (Natural n) = popCount n
  {-# INLINE popCount #-}
  zeroBits = Natural 0
instance Real Natural where
  toRational (Natural a) = toRational a
  {-# INLINE toRational #-}
instance Enum Natural where
  pred (Natural 0) = errorWithoutStackTrace "Natural.pred: 0"
  pred (Natural n) = Natural (pred n)
  {-# INLINE pred #-}
  succ (Natural n) = Natural (succ n)
  {-# INLINE succ #-}
  fromEnum (Natural n) = fromEnum n
  {-# INLINE fromEnum #-}
  toEnum n | n < 0     = errorWithoutStackTrace "Natural.toEnum: negative"
           | otherwise = Natural (toEnum n)
  {-# INLINE toEnum #-}
  enumFrom     = coerce (enumFrom     :: Integer -> [Integer])
  enumFromThen x y
    | x <= y    = coerce (enumFromThen :: Integer -> Integer -> [Integer]) x y
    | otherwise = enumFromThenTo x y 0
  enumFromTo   = coerce (enumFromTo   :: Integer -> Integer -> [Integer])
  enumFromThenTo
    = coerce (enumFromThenTo :: Integer -> Integer -> Integer -> [Integer])
instance Integral Natural where
  quot (Natural a) (Natural b) = Natural (quot a b)
  {-# INLINE quot #-}
  rem (Natural a) (Natural b) = Natural (rem a b)
  {-# INLINE rem #-}
  div (Natural a) (Natural b) = Natural (div a b)
  {-# INLINE div #-}
  mod (Natural a) (Natural b) = Natural (mod a b)
  {-# INLINE mod #-}
  divMod (Natural a) (Natural b) = (Natural q, Natural r)
    where (q,r) = divMod a b
  {-# INLINE divMod #-}
  quotRem (Natural a) (Natural b) = (Natural q, Natural r)
    where (q,r) = quotRem a b
  {-# INLINE quotRem #-}
  toInteger (Natural a) = a
  {-# INLINE toInteger #-}
#endif
wordToNatural :: Word -> Natural
#if defined(MIN_VERSION_integer_gmp)
wordToNatural (W# w#) = NatS# w#
#else
wordToNatural w = Natural (fromIntegral w)
#endif
naturalToWordMaybe :: Natural -> Maybe Word
#if defined(MIN_VERSION_integer_gmp)
naturalToWordMaybe (NatS# w#) = Just (W# w#)
naturalToWordMaybe (NatJ# _)  = Nothing
#else
naturalToWordMaybe (Natural i)
  | i <= maxw  = Just (fromIntegral i)
  | otherwise  = Nothing
  where
    maxw = toInteger (maxBound :: Word)
#endif
powModNatural :: Natural -> Natural -> Natural -> Natural
#if defined(MIN_VERSION_integer_gmp)
powModNatural _           _           (NatS# 0##) = divZeroError
powModNatural _           _           (NatS# 1##) = NatS# 0##
powModNatural _           (NatS# 0##) _           = NatS# 1##
powModNatural (NatS# 0##) _           _           = NatS# 0##
powModNatural (NatS# 1##) _           _           = NatS# 1##
powModNatural (NatS# b)   (NatS# e)   (NatS# m)   = NatS# (powModWord b e m)
powModNatural b           e           (NatS# m)
  = NatS# (powModBigNatWord (naturalToBigNat b) (naturalToBigNat e) m)
powModNatural b           e           (NatJ# m)
  = bigNatToNatural (powModBigNat (naturalToBigNat b) (naturalToBigNat e) m)
#else
powModNatural _ _ 0 = divZeroError
powModNatural _ _ 1 = 0
powModNatural _ 0 _ = 1
powModNatural 0 _ _ = 0
powModNatural 1 _ _ = 1
powModNatural b0 e0 m = go b0 e0 1
  where
    go !b e !r
      | odd e     = go b' e' (r*b `mod` m)
      | e == 0    = r
      | otherwise = go b' e' r
      where
        b' = b*b `mod` m
        e' = e   `unsafeShiftR` 1 
#endif