{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
module GHC.Natural
(
Natural(..)
, mkNatural
, isValidNatural
, plusNatural
, minusNatural
, minusNaturalMaybe
, timesNatural
, negateNatural
, signumNatural
, quotRemNatural
, quotNatural
, remNatural
, gcdNatural
, lcmNatural
, andNatural
, orNatural
, xorNatural
, bitNatural
, testBitNatural
, popCountNatural
, shiftLNatural
, shiftRNatural
, naturalToInteger
, naturalToWord
, naturalToInt
, naturalFromInteger
, wordToNatural
, intToNatural
, naturalToWordMaybe
, wordToNatural#
, wordToNaturalBase
, powModNatural
) where
#include "MachDeps.h"
import GHC.Classes
import GHC.Maybe
import GHC.Types
import GHC.Prim
import {-# SOURCE #-} GHC.Exception.Type (underflowException, divZeroException)
#if defined(MIN_VERSION_integer_gmp)
import GHC.Integer.GMP.Internals
#else
import GHC.Integer
#endif
default ()
#define CONSTANT_FOLDED NOINLINE
{-# NOINLINE underflowError #-}
underflowError :: a
underflowError :: a
underflowError = SomeException -> a
forall b a. b -> a
raise# SomeException
underflowException
{-# NOINLINE divZeroError #-}
divZeroError :: a
divZeroError :: a
divZeroError = SomeException -> a
forall b a. b -> a
raise# SomeException
divZeroException
#if defined(MIN_VERSION_integer_gmp)
data Natural = NatS# GmpLimb#
| NatJ# {-# UNPACK #-} !BigNat
deriving ( Eq
, Ord
)
isValidNatural :: Natural -> Bool
isValidNatural :: Natural -> Bool
isValidNatural (NatS# _) = Bool
True
isValidNatural (NatJ# bn :: BigNat
bn) = Int# -> Bool
isTrue# (BigNat -> Int#
isValidBigNat# BigNat
bn)
Bool -> Bool -> Bool
&& Int# -> Bool
isTrue# (BigNat -> Int#
sizeofBigNat# BigNat
bn Int# -> Int# -> Int#
># 0#)
signumNatural :: Natural -> Natural
signumNatural :: Natural -> Natural
signumNatural (NatS# 0##) = GmpLimb# -> Natural
NatS# 0##
signumNatural _ = GmpLimb# -> Natural
NatS# 1##
negateNatural :: Natural -> Natural
negateNatural :: Natural -> Natural
negateNatural (NatS# 0##) = GmpLimb# -> Natural
NatS# 0##
negateNatural _ = Natural
forall a. a
underflowError
naturalFromInteger :: Integer -> Natural
naturalFromInteger :: Integer -> Natural
naturalFromInteger (S# i# :: Int#
i#)
| Int# -> Bool
isTrue# (Int#
i# Int# -> Int# -> Int#
>=# 0#) = GmpLimb# -> Natural
NatS# (Int# -> GmpLimb#
int2Word# Int#
i#)
naturalFromInteger (Jp# bn :: BigNat
bn) = BigNat -> Natural
bigNatToNatural BigNat
bn
naturalFromInteger _ = Natural
forall a. a
underflowError
{-# CONSTANT_FOLDED naturalFromInteger #-}
gcdNatural :: Natural -> Natural -> Natural
gcdNatural :: Natural -> Natural -> Natural
gcdNatural (NatS# 0##) y :: Natural
y = Natural
y
gcdNatural x :: Natural
x (NatS# 0##) = Natural
x
gcdNatural (NatS# 1##) _ = GmpLimb# -> Natural
NatS# 1##
gcdNatural _ (NatS# 1##) = GmpLimb# -> Natural
NatS# 1##
gcdNatural (NatJ# x :: BigNat
x) (NatJ# y :: BigNat
y) = BigNat -> Natural
bigNatToNatural (BigNat -> BigNat -> BigNat
gcdBigNat BigNat
x BigNat
y)
gcdNatural (NatJ# x :: BigNat
x) (NatS# y :: GmpLimb#
y) = GmpLimb# -> Natural
NatS# (BigNat -> GmpLimb# -> GmpLimb#
gcdBigNatWord BigNat
x GmpLimb#
y)
gcdNatural (NatS# x :: GmpLimb#
x) (NatJ# y :: BigNat
y) = GmpLimb# -> Natural
NatS# (BigNat -> GmpLimb# -> GmpLimb#
gcdBigNatWord BigNat
y GmpLimb#
x)
gcdNatural (NatS# x :: GmpLimb#
x) (NatS# y :: GmpLimb#
y) = GmpLimb# -> Natural
NatS# (GmpLimb# -> GmpLimb# -> GmpLimb#
gcdWord GmpLimb#
x GmpLimb#
y)
lcmNatural :: Natural -> Natural -> Natural
lcmNatural :: Natural -> Natural -> Natural
lcmNatural (NatS# 0##) _ = GmpLimb# -> Natural
NatS# 0##
lcmNatural _ (NatS# 0##) = GmpLimb# -> Natural
NatS# 0##
lcmNatural (NatS# 1##) y :: Natural
y = Natural
y
lcmNatural x :: Natural
x (NatS# 1##) = Natural
x
lcmNatural x :: Natural
x y :: Natural
y = (Natural
x Natural -> Natural -> Natural
`quotNatural` (Natural -> Natural -> Natural
gcdNatural Natural
x Natural
y)) Natural -> Natural -> Natural
`timesNatural` Natural
y
quotRemNatural :: Natural -> Natural -> (Natural, Natural)
quotRemNatural :: Natural -> Natural -> (Natural, Natural)
quotRemNatural _ (NatS# 0##) = (Natural, Natural)
forall a. a
divZeroError
quotRemNatural n :: Natural
n (NatS# 1##) = (Natural
n,GmpLimb# -> Natural
NatS# 0##)
quotRemNatural n :: Natural
n@(NatS# _) (NatJ# _) = (GmpLimb# -> Natural
NatS# 0##, Natural
n)
quotRemNatural (NatS# n :: GmpLimb#
n) (NatS# d :: GmpLimb#
d) = case GmpLimb# -> GmpLimb# -> (# GmpLimb#, GmpLimb# #)
quotRemWord# GmpLimb#
n GmpLimb#
d of
(# q :: GmpLimb#
q, r :: GmpLimb#
r #) -> (GmpLimb# -> Natural
NatS# GmpLimb#
q, GmpLimb# -> Natural
NatS# GmpLimb#
r)
quotRemNatural (NatJ# n :: BigNat
n) (NatS# d :: GmpLimb#
d) = case BigNat -> GmpLimb# -> (# BigNat, GmpLimb# #)
quotRemBigNatWord BigNat
n GmpLimb#
d of
(# q :: BigNat
q, r :: GmpLimb#
r #) -> (BigNat -> Natural
bigNatToNatural BigNat
q, GmpLimb# -> Natural
NatS# GmpLimb#
r)
quotRemNatural (NatJ# n :: BigNat
n) (NatJ# d :: BigNat
d) = case BigNat -> BigNat -> (# BigNat, BigNat #)
quotRemBigNat BigNat
n BigNat
d of
(# q :: BigNat
q, r :: BigNat
r #) -> (BigNat -> Natural
bigNatToNatural BigNat
q, BigNat -> Natural
bigNatToNatural BigNat
r)
quotNatural :: Natural -> Natural -> Natural
quotNatural :: Natural -> Natural -> Natural
quotNatural _ (NatS# 0##) = Natural
forall a. a
divZeroError
quotNatural n :: Natural
n (NatS# 1##) = Natural
n
quotNatural (NatS# _) (NatJ# _) = GmpLimb# -> Natural
NatS# 0##
quotNatural (NatS# n :: GmpLimb#
n) (NatS# d :: GmpLimb#
d) = GmpLimb# -> Natural
NatS# (GmpLimb# -> GmpLimb# -> GmpLimb#
quotWord# GmpLimb#
n GmpLimb#
d)
quotNatural (NatJ# n :: BigNat
n) (NatS# d :: GmpLimb#
d) = BigNat -> Natural
bigNatToNatural (BigNat -> GmpLimb# -> BigNat
quotBigNatWord BigNat
n GmpLimb#
d)
quotNatural (NatJ# n :: BigNat
n) (NatJ# d :: BigNat
d) = BigNat -> Natural
bigNatToNatural (BigNat -> BigNat -> BigNat
quotBigNat BigNat
n BigNat
d)
remNatural :: Natural -> Natural -> Natural
remNatural :: Natural -> Natural -> Natural
remNatural _ (NatS# 0##) = Natural
forall a. a
divZeroError
remNatural _ (NatS# 1##) = GmpLimb# -> Natural
NatS# 0##
remNatural n :: Natural
n@(NatS# _) (NatJ# _) = Natural
n
remNatural (NatS# n :: GmpLimb#
n) (NatS# d :: GmpLimb#
d) = GmpLimb# -> Natural
NatS# (GmpLimb# -> GmpLimb# -> GmpLimb#
remWord# GmpLimb#
n GmpLimb#
d)
remNatural (NatJ# n :: BigNat
n) (NatS# d :: GmpLimb#
d) = GmpLimb# -> Natural
NatS# (BigNat -> GmpLimb# -> GmpLimb#
remBigNatWord BigNat
n GmpLimb#
d)
remNatural (NatJ# n :: BigNat
n) (NatJ# d :: BigNat
d) = BigNat -> Natural
bigNatToNatural (BigNat -> BigNat -> BigNat
remBigNat BigNat
n BigNat
d)
naturalToInteger :: Natural -> Integer
naturalToInteger :: Natural -> Integer
naturalToInteger (NatS# w :: GmpLimb#
w) = GmpLimb# -> Integer
wordToInteger GmpLimb#
w
naturalToInteger (NatJ# bn :: BigNat
bn) = BigNat -> Integer
Jp# BigNat
bn
{-# CONSTANT_FOLDED naturalToInteger #-}
andNatural :: Natural -> Natural -> Natural
andNatural :: Natural -> Natural -> Natural
andNatural (NatS# n :: GmpLimb#
n) (NatS# m :: GmpLimb#
m) = GmpLimb# -> Natural
NatS# (GmpLimb#
n GmpLimb# -> GmpLimb# -> GmpLimb#
`and#` GmpLimb#
m)
andNatural (NatS# n :: GmpLimb#
n) (NatJ# m :: BigNat
m) = GmpLimb# -> Natural
NatS# (GmpLimb#
n GmpLimb# -> GmpLimb# -> GmpLimb#
`and#` BigNat -> GmpLimb#
bigNatToWord BigNat
m)
andNatural (NatJ# n :: BigNat
n) (NatS# m :: GmpLimb#
m) = GmpLimb# -> Natural
NatS# (BigNat -> GmpLimb#
bigNatToWord BigNat
n GmpLimb# -> GmpLimb# -> GmpLimb#
`and#` GmpLimb#
m)
andNatural (NatJ# n :: BigNat
n) (NatJ# m :: BigNat
m) = BigNat -> Natural
bigNatToNatural (BigNat -> BigNat -> BigNat
andBigNat BigNat
n BigNat
m)
orNatural :: Natural -> Natural -> Natural
orNatural :: Natural -> Natural -> Natural
orNatural (NatS# n :: GmpLimb#
n) (NatS# m :: GmpLimb#
m) = GmpLimb# -> Natural
NatS# (GmpLimb#
n GmpLimb# -> GmpLimb# -> GmpLimb#
`or#` GmpLimb#
m)
orNatural (NatS# n :: GmpLimb#
n) (NatJ# m :: BigNat
m) = BigNat -> Natural
NatJ# (BigNat -> BigNat -> BigNat
orBigNat (GmpLimb# -> BigNat
wordToBigNat GmpLimb#
n) BigNat
m)
orNatural (NatJ# n :: BigNat
n) (NatS# m :: GmpLimb#
m) = BigNat -> Natural
NatJ# (BigNat -> BigNat -> BigNat
orBigNat BigNat
n (GmpLimb# -> BigNat
wordToBigNat GmpLimb#
m))
orNatural (NatJ# n :: BigNat
n) (NatJ# m :: BigNat
m) = BigNat -> Natural
NatJ# (BigNat -> BigNat -> BigNat
orBigNat BigNat
n BigNat
m)
xorNatural :: Natural -> Natural -> Natural
xorNatural :: Natural -> Natural -> Natural
xorNatural (NatS# n :: GmpLimb#
n) (NatS# m :: GmpLimb#
m) = GmpLimb# -> Natural
NatS# (GmpLimb#
n GmpLimb# -> GmpLimb# -> GmpLimb#
`xor#` GmpLimb#
m)
xorNatural (NatS# n :: GmpLimb#
n) (NatJ# m :: BigNat
m) = BigNat -> Natural
NatJ# (BigNat -> BigNat -> BigNat
xorBigNat (GmpLimb# -> BigNat
wordToBigNat GmpLimb#
n) BigNat
m)
xorNatural (NatJ# n :: BigNat
n) (NatS# m :: GmpLimb#
m) = BigNat -> Natural
NatJ# (BigNat -> BigNat -> BigNat
xorBigNat BigNat
n (GmpLimb# -> BigNat
wordToBigNat GmpLimb#
m))
xorNatural (NatJ# n :: BigNat
n) (NatJ# m :: BigNat
m) = BigNat -> Natural
bigNatToNatural (BigNat -> BigNat -> BigNat
xorBigNat BigNat
n BigNat
m)
bitNatural :: Int# -> Natural
bitNatural :: Int# -> Natural
bitNatural i# :: Int#
i#
| Int# -> Bool
isTrue# (Int#
i# Int# -> Int# -> Int#
<# WORD_SIZE_IN_BITS#) = NatS# (1## `uncheckedShiftL#` i#)
| Bool
True = BigNat -> Natural
NatJ# (Int# -> BigNat
bitBigNat Int#
i#)
testBitNatural :: Natural -> Int -> Bool
testBitNatural :: Natural -> Int -> Bool
testBitNatural (NatS# w :: GmpLimb#
w) (I# i# :: Int#
i#)
| Int# -> Bool
isTrue# (Int#
i# Int# -> Int# -> Int#
<# WORD_SIZE_IN_BITS#) =
Int# -> Bool
isTrue# ((GmpLimb#
w GmpLimb# -> GmpLimb# -> GmpLimb#
`and#` (1## GmpLimb# -> Int# -> GmpLimb#
`uncheckedShiftL#` Int#
i#)) GmpLimb# -> GmpLimb# -> Int#
`neWord#` 0##)
| Bool
True = Bool
False
testBitNatural (NatJ# bn :: BigNat
bn) (I# i# :: Int#
i#) = BigNat -> Int# -> Bool
testBitBigNat BigNat
bn Int#
i#
popCountNatural :: Natural -> Int
popCountNatural :: Natural -> Int
popCountNatural (NatS# w :: GmpLimb#
w) = Int# -> Int
I# (GmpLimb# -> Int#
word2Int# (GmpLimb# -> GmpLimb#
popCnt# GmpLimb#
w))
popCountNatural (NatJ# bn :: BigNat
bn) = Int# -> Int
I# (BigNat -> Int#
popCountBigNat BigNat
bn)
shiftLNatural :: Natural -> Int -> Natural
shiftLNatural :: Natural -> Int -> Natural
shiftLNatural n :: Natural
n (I# 0#) = Natural
n
shiftLNatural (NatS# 0##) _ = GmpLimb# -> Natural
NatS# 0##
shiftLNatural (NatS# 1##) (I# i# :: Int#
i#) = Int# -> Natural
bitNatural Int#
i#
shiftLNatural (NatS# w :: GmpLimb#
w) (I# i# :: Int#
i#)
= BigNat -> Natural
bigNatToNatural (BigNat -> Int# -> BigNat
shiftLBigNat (GmpLimb# -> BigNat
wordToBigNat GmpLimb#
w) Int#
i#)
shiftLNatural (NatJ# bn :: BigNat
bn) (I# i# :: Int#
i#)
= BigNat -> Natural
bigNatToNatural (BigNat -> Int# -> BigNat
shiftLBigNat BigNat
bn Int#
i#)
shiftRNatural :: Natural -> Int -> Natural
shiftRNatural :: Natural -> Int -> Natural
shiftRNatural n :: Natural
n (I# 0#) = Natural
n
shiftRNatural (NatS# w :: GmpLimb#
w) (I# i# :: Int#
i#)
| Int# -> Bool
isTrue# (Int#
i# Int# -> Int# -> Int#
>=# WORD_SIZE_IN_BITS#) = NatS# 0##
| Bool
True = GmpLimb# -> Natural
NatS# (GmpLimb#
w GmpLimb# -> Int# -> GmpLimb#
`uncheckedShiftRL#` Int#
i#)
shiftRNatural (NatJ# bn :: BigNat
bn) (I# i# :: Int#
i#) = BigNat -> Natural
bigNatToNatural (BigNat -> Int# -> BigNat
shiftRBigNat BigNat
bn Int#
i#)
plusNatural :: Natural -> Natural -> Natural
plusNatural :: Natural -> Natural -> Natural
plusNatural (NatS# 0##) y :: Natural
y = Natural
y
plusNatural x :: Natural
x (NatS# 0##) = Natural
x
plusNatural (NatS# x :: GmpLimb#
x) (NatS# y :: GmpLimb#
y)
= case GmpLimb# -> GmpLimb# -> (# GmpLimb#, GmpLimb# #)
plusWord2# GmpLimb#
x GmpLimb#
y of
(# 0##, l :: GmpLimb#
l #) -> GmpLimb# -> Natural
NatS# GmpLimb#
l
(# h :: GmpLimb#
h, l :: GmpLimb#
l #) -> BigNat -> Natural
NatJ# (GmpLimb# -> GmpLimb# -> BigNat
wordToBigNat2 GmpLimb#
h GmpLimb#
l)
plusNatural (NatS# x :: GmpLimb#
x) (NatJ# y :: BigNat
y) = BigNat -> Natural
NatJ# (BigNat -> GmpLimb# -> BigNat
plusBigNatWord BigNat
y GmpLimb#
x)
plusNatural (NatJ# x :: BigNat
x) (NatS# y :: GmpLimb#
y) = BigNat -> Natural
NatJ# (BigNat -> GmpLimb# -> BigNat
plusBigNatWord BigNat
x GmpLimb#
y)
plusNatural (NatJ# x :: BigNat
x) (NatJ# y :: BigNat
y) = BigNat -> Natural
NatJ# (BigNat -> BigNat -> BigNat
plusBigNat BigNat
x BigNat
y)
{-# CONSTANT_FOLDED plusNatural #-}
timesNatural :: Natural -> Natural -> Natural
timesNatural :: Natural -> Natural -> Natural
timesNatural _ (NatS# 0##) = GmpLimb# -> Natural
NatS# 0##
timesNatural (NatS# 0##) _ = GmpLimb# -> Natural
NatS# 0##
timesNatural x :: Natural
x (NatS# 1##) = Natural
x
timesNatural (NatS# 1##) y :: Natural
y = Natural
y
timesNatural (NatS# x :: GmpLimb#
x) (NatS# y :: GmpLimb#
y) = case GmpLimb# -> GmpLimb# -> (# GmpLimb#, GmpLimb# #)
timesWord2# GmpLimb#
x GmpLimb#
y of
(# 0##, 0## #) -> GmpLimb# -> Natural
NatS# 0##
(# 0##, xy :: GmpLimb#
xy #) -> GmpLimb# -> Natural
NatS# GmpLimb#
xy
(# h :: GmpLimb#
h , l :: GmpLimb#
l #) -> BigNat -> Natural
NatJ# (GmpLimb# -> GmpLimb# -> BigNat
wordToBigNat2 GmpLimb#
h GmpLimb#
l)
timesNatural (NatS# x :: GmpLimb#
x) (NatJ# y :: BigNat
y) = BigNat -> Natural
NatJ# (BigNat -> GmpLimb# -> BigNat
timesBigNatWord BigNat
y GmpLimb#
x)
timesNatural (NatJ# x :: BigNat
x) (NatS# y :: GmpLimb#
y) = BigNat -> Natural
NatJ# (BigNat -> GmpLimb# -> BigNat
timesBigNatWord BigNat
x GmpLimb#
y)
timesNatural (NatJ# x :: BigNat
x) (NatJ# y :: BigNat
y) = BigNat -> Natural
NatJ# (BigNat -> BigNat -> BigNat
timesBigNat BigNat
x BigNat
y)
{-# CONSTANT_FOLDED timesNatural #-}
minusNatural :: Natural -> Natural -> Natural
minusNatural :: Natural -> Natural -> Natural
minusNatural x :: Natural
x (NatS# 0##) = Natural
x
minusNatural (NatS# x :: GmpLimb#
x) (NatS# y :: GmpLimb#
y) = case GmpLimb# -> GmpLimb# -> (# GmpLimb#, Int# #)
subWordC# GmpLimb#
x GmpLimb#
y of
(# l :: GmpLimb#
l, 0# #) -> GmpLimb# -> Natural
NatS# GmpLimb#
l
_ -> Natural
forall a. a
underflowError
minusNatural (NatS# _) (NatJ# _) = Natural
forall a. a
underflowError
minusNatural (NatJ# x :: BigNat
x) (NatS# y :: GmpLimb#
y)
= BigNat -> Natural
bigNatToNatural (BigNat -> GmpLimb# -> BigNat
minusBigNatWord BigNat
x GmpLimb#
y)
minusNatural (NatJ# x :: BigNat
x) (NatJ# y :: BigNat
y)
= BigNat -> Natural
bigNatToNatural (BigNat -> BigNat -> BigNat
minusBigNat BigNat
x BigNat
y)
{-# CONSTANT_FOLDED minusNatural #-}
minusNaturalMaybe :: Natural -> Natural -> Maybe Natural
minusNaturalMaybe :: Natural -> Natural -> Maybe Natural
minusNaturalMaybe x :: Natural
x (NatS# 0##) = Natural -> Maybe Natural
forall a. a -> Maybe a
Just Natural
x
minusNaturalMaybe (NatS# x :: GmpLimb#
x) (NatS# y :: GmpLimb#
y) = case GmpLimb# -> GmpLimb# -> (# GmpLimb#, Int# #)
subWordC# GmpLimb#
x GmpLimb#
y of
(# l :: GmpLimb#
l, 0# #) -> Natural -> Maybe Natural
forall a. a -> Maybe a
Just (GmpLimb# -> Natural
NatS# GmpLimb#
l)
_ -> Maybe Natural
forall a. Maybe a
Nothing
minusNaturalMaybe (NatS# _) (NatJ# _) = Maybe Natural
forall a. Maybe a
Nothing
minusNaturalMaybe (NatJ# x :: BigNat
x) (NatS# y :: GmpLimb#
y)
= Natural -> Maybe Natural
forall a. a -> Maybe a
Just (BigNat -> Natural
bigNatToNatural (BigNat -> GmpLimb# -> BigNat
minusBigNatWord BigNat
x GmpLimb#
y))
minusNaturalMaybe (NatJ# x :: BigNat
x) (NatJ# y :: BigNat
y)
| Int# -> Bool
isTrue# (BigNat -> Int#
isNullBigNat# BigNat
res) = Maybe Natural
forall a. Maybe a
Nothing
| Bool
True = Natural -> Maybe Natural
forall a. a -> Maybe a
Just (BigNat -> Natural
bigNatToNatural BigNat
res)
where
res :: BigNat
res = BigNat -> BigNat -> BigNat
minusBigNat BigNat
x BigNat
y
bigNatToNatural :: BigNat -> Natural
bigNatToNatural :: BigNat -> Natural
bigNatToNatural bn :: BigNat
bn
| Int# -> Bool
isTrue# (BigNat -> Int#
sizeofBigNat# BigNat
bn Int# -> Int# -> Int#
==# 1#) = GmpLimb# -> Natural
NatS# (BigNat -> GmpLimb#
bigNatToWord BigNat
bn)
| Int# -> Bool
isTrue# (BigNat -> Int#
isNullBigNat# BigNat
bn) = Natural
forall a. a
underflowError
| Bool
True = BigNat -> Natural
NatJ# BigNat
bn
naturalToBigNat :: Natural -> BigNat
naturalToBigNat :: Natural -> BigNat
naturalToBigNat (NatS# w# :: GmpLimb#
w#) = GmpLimb# -> BigNat
wordToBigNat GmpLimb#
w#
naturalToBigNat (NatJ# bn :: BigNat
bn) = BigNat
bn
naturalToWord :: Natural -> Word
naturalToWord :: Natural -> Word
naturalToWord (NatS# w# :: GmpLimb#
w#) = GmpLimb# -> Word
W# GmpLimb#
w#
naturalToWord (NatJ# bn :: BigNat
bn) = GmpLimb# -> Word
W# (BigNat -> GmpLimb#
bigNatToWord BigNat
bn)
naturalToInt :: Natural -> Int
naturalToInt :: Natural -> Int
naturalToInt (NatS# w# :: GmpLimb#
w#) = Int# -> Int
I# (GmpLimb# -> Int#
word2Int# GmpLimb#
w#)
naturalToInt (NatJ# bn :: BigNat
bn) = Int# -> Int
I# (BigNat -> Int#
bigNatToInt BigNat
bn)
wordToNatural# :: Word# -> Natural
wordToNatural# :: GmpLimb# -> Natural
wordToNatural# w# :: GmpLimb#
w# = GmpLimb# -> Natural
NatS# GmpLimb#
w#
{-# CONSTANT_FOLDED wordToNatural# #-}
wordToNaturalBase :: Word# -> Natural
wordToNaturalBase :: GmpLimb# -> Natural
wordToNaturalBase w# :: GmpLimb#
w# = GmpLimb# -> Natural
NatS# GmpLimb#
w#
#else /* !defined(MIN_VERSION_integer_gmp) */
newtype Natural = Natural Integer
deriving (Eq,Ord)
isValidNatural :: Natural -> Bool
isValidNatural (Natural i) = i >= wordToInteger 0##
wordToNatural# :: Word# -> Natural
wordToNatural# w## = Natural (wordToInteger w##)
{-# CONSTANT_FOLDED wordToNatural# #-}
wordToNaturalBase :: Word# -> Natural
wordToNaturalBase w## = Natural (wordToInteger w##)
naturalFromInteger :: Integer -> Natural
naturalFromInteger n
| n >= wordToInteger 0## = Natural n
| True = underflowError
{-# INLINE naturalFromInteger #-}
gcdNatural :: Natural -> Natural -> Natural
gcdNatural (Natural n) (Natural m) = Natural (n `gcdInteger` m)
lcmNatural :: Natural -> Natural -> Natural
lcmNatural (Natural n) (Natural m) = Natural (n `lcmInteger` m)
minusNaturalMaybe :: Natural -> Natural -> Maybe Natural
minusNaturalMaybe (Natural x) (Natural y)
| x >= y = Just (Natural (x `minusInteger` y))
| True = Nothing
shiftLNatural :: Natural -> Int -> Natural
shiftLNatural (Natural n) (I# i) = Natural (n `shiftLInteger` i)
shiftRNatural :: Natural -> Int -> Natural
shiftRNatural (Natural n) (I# i) = Natural (n `shiftRInteger` i)
plusNatural :: Natural -> Natural -> Natural
plusNatural (Natural x) (Natural y) = Natural (x `plusInteger` y)
{-# CONSTANT_FOLDED plusNatural #-}
minusNatural :: Natural -> Natural -> Natural
minusNatural (Natural x) (Natural y)
= if z `ltInteger` wordToInteger 0## then underflowError else Natural z
where z = x `minusInteger` y
{-# CONSTANT_FOLDED minusNatural #-}
timesNatural :: Natural -> Natural -> Natural
timesNatural (Natural x) (Natural y) = Natural (x `timesInteger` y)
{-# CONSTANT_FOLDED timesNatural #-}
orNatural :: Natural -> Natural -> Natural
orNatural (Natural x) (Natural y) = Natural (x `orInteger` y)
xorNatural :: Natural -> Natural -> Natural
xorNatural (Natural x) (Natural y) = Natural (x `xorInteger` y)
andNatural :: Natural -> Natural -> Natural
andNatural (Natural x) (Natural y) = Natural (x `andInteger` y)
naturalToInt :: Natural -> Int
naturalToInt (Natural i) = I# (integerToInt i)
naturalToWord :: Natural -> Word
naturalToWord (Natural i) = W# (integerToWord i)
naturalToInteger :: Natural -> Integer
naturalToInteger (Natural i) = i
{-# CONSTANT_FOLDED naturalToInteger #-}
testBitNatural :: Natural -> Int -> Bool
testBitNatural (Natural n) (I# i) = testBitInteger n i
popCountNatural :: Natural -> Int
popCountNatural (Natural n) = I# (popCountInteger n)
bitNatural :: Int# -> Natural
bitNatural i#
| isTrue# (i# <# WORD_SIZE_IN_BITS#) = wordToNaturalBase (1## `uncheckedShiftL#` i#)
| True = Natural (1 `shiftLInteger` i#)
quotNatural :: Natural -> Natural -> Natural
quotNatural n@(Natural x) (Natural y)
| y == wordToInteger 0## = divZeroError
| y == wordToInteger 1## = n
| True = Natural (x `quotInteger` y)
remNatural :: Natural -> Natural -> Natural
remNatural (Natural x) (Natural y)
| y == wordToInteger 0## = divZeroError
| y == wordToInteger 1## = wordToNaturalBase 0##
| True = Natural (x `remInteger` y)
quotRemNatural :: Natural -> Natural -> (Natural, Natural)
quotRemNatural n@(Natural x) (Natural y)
| y == wordToInteger 0## = divZeroError
| y == wordToInteger 1## = (n,wordToNaturalBase 0##)
| True = case quotRemInteger x y of
(# k, r #) -> (Natural k, Natural r)
signumNatural :: Natural -> Natural
signumNatural (Natural x)
| x == wordToInteger 0## = wordToNaturalBase 0##
| True = wordToNaturalBase 1##
negateNatural :: Natural -> Natural
negateNatural (Natural x)
| x == wordToInteger 0## = wordToNaturalBase 0##
| True = underflowError
#endif
wordToNatural :: Word -> Natural
wordToNatural :: Word -> Natural
wordToNatural (W# w# :: GmpLimb#
w#) = GmpLimb# -> Natural
wordToNatural# GmpLimb#
w#
naturalToWordMaybe :: Natural -> Maybe Word
#if defined(MIN_VERSION_integer_gmp)
naturalToWordMaybe :: Natural -> Maybe Word
naturalToWordMaybe (NatS# w# :: GmpLimb#
w#) = Word -> Maybe Word
forall a. a -> Maybe a
Just (GmpLimb# -> Word
W# GmpLimb#
w#)
naturalToWordMaybe (NatJ# _) = Maybe Word
forall a. Maybe a
Nothing
#else
naturalToWordMaybe (Natural i)
| i < maxw = Just (W# (integerToWord i))
| True = Nothing
where
maxw = 1 `shiftLInteger` WORD_SIZE_IN_BITS#
#endif
powModNatural :: Natural -> Natural -> Natural -> Natural
#if defined(MIN_VERSION_integer_gmp)
powModNatural :: Natural -> Natural -> Natural -> Natural
powModNatural _ _ (NatS# 0##) = Natural
forall a. a
divZeroError
powModNatural _ _ (NatS# 1##) = GmpLimb# -> Natural
NatS# 0##
powModNatural _ (NatS# 0##) _ = GmpLimb# -> Natural
NatS# 1##
powModNatural (NatS# 0##) _ _ = GmpLimb# -> Natural
NatS# 0##
powModNatural (NatS# 1##) _ _ = GmpLimb# -> Natural
NatS# 1##
powModNatural (NatS# b :: GmpLimb#
b) (NatS# e :: GmpLimb#
e) (NatS# m :: GmpLimb#
m) = GmpLimb# -> Natural
NatS# (GmpLimb# -> GmpLimb# -> GmpLimb# -> GmpLimb#
powModWord GmpLimb#
b GmpLimb#
e GmpLimb#
m)
powModNatural b :: Natural
b e :: Natural
e (NatS# m :: GmpLimb#
m)
= GmpLimb# -> Natural
NatS# (BigNat -> BigNat -> GmpLimb# -> GmpLimb#
powModBigNatWord (Natural -> BigNat
naturalToBigNat Natural
b) (Natural -> BigNat
naturalToBigNat Natural
e) GmpLimb#
m)
powModNatural b :: Natural
b e :: Natural
e (NatJ# m :: BigNat
m)
= BigNat -> Natural
bigNatToNatural (BigNat -> BigNat -> BigNat -> BigNat
powModBigNat (Natural -> BigNat
naturalToBigNat Natural
b) (Natural -> BigNat
naturalToBigNat Natural
e) BigNat
m)
#else
powModNatural (Natural b0) (Natural e0) (Natural m)
| m == wordToInteger 0## = divZeroError
| m == wordToInteger 1## = wordToNaturalBase 0##
| e0 == wordToInteger 0## = wordToNaturalBase 1##
| b0 == wordToInteger 0## = wordToNaturalBase 0##
| b0 == wordToInteger 1## = wordToNaturalBase 1##
| True = go b0 e0 (wordToInteger 1##)
where
go !b e !r
| e `testBitInteger` 0# = go b' e' ((r `timesInteger` b) `modInteger` m)
| e == wordToInteger 0## = naturalFromInteger r
| True = go b' e' r
where
b' = (b `timesInteger` b) `modInteger` m
e' = e `shiftRInteger` 1#
#endif
mkNatural :: [Word]
-> Natural
mkNatural :: [Word] -> Natural
mkNatural [] = GmpLimb# -> Natural
wordToNaturalBase 0##
mkNatural (W# i :: GmpLimb#
i : is' :: [Word]
is') = GmpLimb# -> Natural
wordToNaturalBase (GmpLimb#
i GmpLimb# -> GmpLimb# -> GmpLimb#
`and#` 0xffffffff##) Natural -> Natural -> Natural
`orNatural`
Natural -> Int -> Natural
shiftLNatural ([Word] -> Natural
mkNatural [Word]
is') 32
{-# CONSTANT_FOLDED mkNatural #-}
intToNatural :: Int -> Natural
intToNatural :: Int -> Natural
intToNatural (I# i# :: Int#
i#)
| Int# -> Bool
isTrue# (Int#
i# Int# -> Int# -> Int#
<# 0#) = Natural
forall a. a
underflowError
| Bool
True = GmpLimb# -> Natural
wordToNaturalBase (Int# -> GmpLimb#
int2Word# Int#
i#)