{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE Unsafe #-} {-# OPTIONS_HADDOCK not-home #-} ----------------------------------------------------------------------------- -- | -- Module : GHC.Natural -- Copyright : (C) 2014 Herbert Valerio Riedel, -- (C) 2011 Edward Kmett -- License : see libraries/base/LICENSE -- -- Maintainer : libraries@haskell.org -- Stability : internal -- Portability : non-portable (GHC Extensions) -- -- The arbitrary-precision 'Natural' number type. -- -- __Note__: This is an internal GHC module with an API subject to -- change. It's recommended use the "Numeric.Natural" module to import -- the 'Natural' type. -- -- @since 4.8.0.0 ----------------------------------------------------------------------------- module GHC.Natural ( -- * The 'Natural' number type -- -- | __Warning__: The internal implementation of 'Natural' -- (i.e. which constructors are available) depends on the -- 'Integer' backend used! Natural(..) , isValidNatural -- * Conversions , naturalFromInteger , wordToNatural , naturalToWordMaybe -- * Checked subtraction , minusNaturalMaybe -- * Modular arithmetic , 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 () ------------------------------------------------------------------------------- -- Arithmetic underflow ------------------------------------------------------------------------------- -- We put them here because they are needed relatively early -- in the libraries before the Exception type has been defined yet. {-# NOINLINE underflowError #-} underflowError :: a underflowError = raise# underflowException ------------------------------------------------------------------------------- -- Natural type ------------------------------------------------------------------------------- #if defined(MIN_VERSION_integer_gmp) -- TODO: if saturated arithmetic is to used, replace 'underflowError' by '0' -- | Type representing arbitrary-precision non-negative integers. -- -- >>> 2^20 :: Natural -- 1267650600228229401496703205376 -- -- Operations whose result would be negative @'throw' ('Underflow' :: 'ArithException')@, -- -- >>> -1 :: Natural -- *** Exception: arithmetic underflow -- -- @since 4.8.0.0 data Natural = NatS# GmpLimb# -- ^ in @[0, maxBound::Word]@ | NatJ# {-# UNPACK #-} !BigNat -- ^ in @]maxBound::Word, +inf[@ -- -- __Invariant__: 'NatJ#' is used -- /iff/ value doesn't fit in -- 'NatS#' constructor. deriving (Eq,Ord) -- NB: Order of constructors *must* -- coincide with 'Ord' relation -- | Test whether all internal invariants are satisfied by 'Natural' value -- -- This operation is mostly useful for test-suites and/or code which -- constructs 'Integer' values directly. -- -- @since 4.8.0.0 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 -- these RULES are valid for Word==Word64 & Int==Int64 {-# 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 -- | @since 4.8.0.0 instance Show Natural where showsPrec p (NatS# w#) = showsPrec p (W# w#) showsPrec p (NatJ# bn) = showsPrec p (Jp# bn) -- | @since 4.8.0.0 instance Read Natural where readsPrec d = map (\(n, s) -> (fromInteger n, s)) . filter ((>= 0) . (\(x,_)->x)) . readsPrec d -- | @since 4.8.0.0 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 -- | @since 4.10.0.0 naturalFromInteger :: Integer -> Natural naturalFromInteger (S# i#) | I# i# >= 0 = NatS# (int2Word# i#) naturalFromInteger (Jp# bn) = bigNatToNatural bn naturalFromInteger _ = underflowError {-# INLINE naturalFromInteger #-} -- | @since 4.8.0.0 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 #-} -- | Compute greatest common divisor. 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) -- | compute least common multiplier. 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 -- | @since 4.8.0.0 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 ---------------------------------------------------------------------------- -- Helpers for 'Enum Natural'; TODO: optimise & make fusion work 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] ---------------------------------------------------------------------------- -- | @since 4.8.0.0 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) -- | @since 4.8.0.0 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" -- | @since 4.8.0.0 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## ---------------------------------------------------------------------------- -- | 'Natural' Addition 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) -- | 'Natural' multiplication 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 -- | 'Natural' subtraction. May @'throw' 'Underflow'@. 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 -- | 'Natural' subtraction. Returns 'Nothing's for non-positive results. -- -- @since 4.8.0.0 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 -- | Convert 'BigNat' to 'Natural'. -- Throws 'Underflow' if passed a 'nullBigNat'. 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 -- | Convert 'Int' to 'Natural'. -- Throws 'Underflow' when passed a negative 'Int'. 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) */ ---------------------------------------------------------------------------- -- Use wrapped 'Integer' as fallback; taken from Edward Kmett's nats package -- | Type representing arbitrary-precision non-negative integers. -- -- Operations whose result would be negative -- @'throw' ('Underflow' :: 'ArithException')@. -- -- @since 4.8.0.0 newtype Natural = Natural Integer -- ^ __Invariant__: non-negative 'Integer' deriving (Eq,Ord,Ix) -- | Test whether all internal invariants are satisfied by 'Natural' value -- -- This operation is mostly useful for test-suites and/or code which -- constructs 'Integer' values directly. -- -- @since 4.8.0.0 isValidNatural :: Natural -> Bool isValidNatural (Natural i) = i >= 0 -- | @since 4.8.0.0 instance Read Natural where readsPrec d = map (\(n, s) -> (Natural n, s)) . filter ((>= 0) . (\(x,_)->x)) . readsPrec d -- | @since 4.8.0.0 instance Show Natural where showsPrec d (Natural i) = showsPrec d i -- | @since 4.8.0.0 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 #-} -- | @since 4.10.0.0 naturalFromInteger :: Integer -> Natural naturalFromInteger n | n >= 0 = Natural n | otherwise = underflowError {-# INLINE naturalFromInteger #-} -- | 'Natural' subtraction. Returns 'Nothing's for non-positive results. -- -- @since 4.8.0.0 minusNaturalMaybe :: Natural -> Natural -> Maybe Natural minusNaturalMaybe x y | x >= y = Just (x - y) | otherwise = Nothing -- | @since 4.8.0.0 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 -- | @since 4.8.0.0 instance Real Natural where toRational (Natural a) = toRational a {-# INLINE toRational #-} -- | @since 4.8.0.0 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]) -- | @since 4.8.0.0 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 -- | Construct 'Natural' from 'Word' value. -- -- @since 4.8.0.0 wordToNatural :: Word -> Natural #if defined(MIN_VERSION_integer_gmp) wordToNatural (W# w#) = NatS# w# #else wordToNatural w = Natural (fromIntegral w) #endif -- | Try downcasting 'Natural' to 'Word' value. -- Returns 'Nothing' if value doesn't fit in 'Word'. -- -- @since 4.8.0.0 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' /b/ /e/ /m/@\" computes base @/b/@ raised to -- exponent @/e/@ modulo @/m/@. -- -- @since 4.8.0.0 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 -- Portable reference fallback implementation 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 -- slightly faster than "e `div` 2" #endif