From d3bd68978476487591fc60f7feb7cfb36b8fc3a3 Mon Sep 17 00:00:00 2001 From: Sylvain Henry Date: Mon, 6 Jul 2020 15:08:31 +0200 Subject: BigNum: rename BigNat types Before this patch BigNat names were confusing because we had: * GHC.Num.BigNat.BigNat: unlifted type used everywhere else * GHC.Num.BigNat.BigNatW: lifted type only used to share static constants * GHC.Natural.BigNat: lifted type only used for backward compatibility After this patch we have: * GHC.Num.BigNat.BigNat#: unlifted type * GHC.Num.BigNat.BigNat: lifted type (reexported from GHC.Natural) Thanks to @RyanGlScott for spotting this. --- libraries/ghc-bignum/src/GHC/Num/BigNat.hs | 358 +++++++++++----------- libraries/ghc-bignum/src/GHC/Num/BigNat/Native.hs | 10 +- libraries/ghc-bignum/src/GHC/Num/Integer.hs | 166 +++++----- libraries/ghc-bignum/src/GHC/Num/Natural.hs | 78 ++--- 4 files changed, 312 insertions(+), 300 deletions(-) (limited to 'libraries/ghc-bignum') diff --git a/libraries/ghc-bignum/src/GHC/Num/BigNat.hs b/libraries/ghc-bignum/src/GHC/Num/BigNat.hs index cf08320a11..6b4523ad00 100644 --- a/libraries/ghc-bignum/src/GHC/Num/BigNat.hs +++ b/libraries/ghc-bignum/src/GHC/Num/BigNat.hs @@ -52,90 +52,102 @@ default () -- themselves use machine order). -- -- Invariant (canonical representation): higher Word# is non-zero. +-- +-- As a consequence, zero is represented with a WordArray# whose size is 0. +type BigNat# = WordArray# + -- we use a type-alias instead of an unlifted newtype to make Integer/Natural + -- types easier to wire in the compiler + +-- | A lifted BigNat +-- +-- Represented as an array of limbs (Word#) stored in little-endian order (Word# +-- themselves use machine order). +-- +-- Invariant (canonical representation): higher Word# is non-zero. +-- -- As a consequence, zero is represented with a WordArray# whose size is 0. -type BigNat = WordArray# -- we use a type-alias to make Integer/Natural easier to wire-in +data BigNat = BN# { unBigNat :: BigNat# } + +-- Note [Why Void#?] +-- ~~~~~~~~~~~~~~~~~ +-- +-- We can't have top-level BigNat# for now because they are unlifted ByteArray# +-- (see #17521). So we use functions that take an empty argument Void# that +-- will be discarded at compile time. + -- | Check that the BigNat is valid -bigNatCheck# :: BigNat -> Bool# +bigNatCheck# :: BigNat# -> Bool# bigNatCheck# bn | 0# <- bigNatSize# bn = 1# | 0## <- bigNatIndex# bn (bigNatSize# bn -# 1#) = 0# | True = 1# -- | Check that the BigNat is valid -bigNatCheck :: BigNat -> Bool +bigNatCheck :: BigNat# -> Bool bigNatCheck bn = isTrue# (bigNatCheck# bn) -- | Number of words in the BigNat -bigNatSize :: BigNat -> Word +bigNatSize :: BigNat# -> Word bigNatSize bn = W# (int2Word# (bigNatSize# bn)) -- | Number of words in the BigNat -bigNatSize# :: BigNat -> Int# +bigNatSize# :: BigNat# -> Int# bigNatSize# ba = wordArraySize# ba --- Note [Why Void#?] --- ~~~~~~~~~~~~~~~~~ --- --- We can't have top-level BigNat for now because they are unlifted ByteArray# --- (see #17521). So we use functions that take an empty argument Void# that --- will be discarded at compile time. - -data BigNatW = BigNatW BigNat - -{-# NOINLINE bigNatZeroW #-} -bigNatZeroW :: BigNatW -bigNatZeroW = BigNatW (withNewWordArray# 0# (\_ s -> s)) +{-# NOINLINE bigNatZero #-} +bigNatZero :: BigNat +bigNatZero = BN# (withNewWordArray# 0# (\_ s -> s)) -{-# NOINLINE bigNatOneW #-} -bigNatOneW :: BigNatW -bigNatOneW = BigNatW (bigNatFromWord# 1##) +{-# NOINLINE bigNatOne #-} +bigNatOne :: BigNat +bigNatOne = BN# (bigNatFromWord# 1##) -- | BigNat Zero -bigNatZero :: Void# -> BigNat -- cf Note [Why Void#?] -bigNatZero _ = case bigNatZeroW of - BigNatW w -> w +bigNatZero# :: Void# -> BigNat# -- cf Note [Why Void#?] +bigNatZero# _ = case bigNatZero of + BN# w -> w -- | BigNat one -bigNatOne :: Void# -> BigNat -- cf Note [Why Void#?] -bigNatOne _ = case bigNatOneW of - BigNatW w -> w +bigNatOne# :: Void# -> BigNat# -- cf Note [Why Void#?] +bigNatOne# _ = case bigNatOne of + BN# w -> w -raiseDivZero_BigNat :: Void# -> BigNat +raiseDivZero_BigNat :: Void# -> BigNat# raiseDivZero_BigNat _ = case raiseDivZero of - !_ -> bigNatZero void# + !_ -> bigNatZero# void# -- see Note [ghc-bignum exceptions] in GHC.Num.Primitives -- | Indicate if a bigNat is zero -bigNatIsZero :: BigNat -> Bool +bigNatIsZero :: BigNat# -> Bool bigNatIsZero bn = isTrue# (bigNatIsZero# bn) -- | Indicate if a bigNat is zero -bigNatIsZero# :: BigNat -> Bool# +bigNatIsZero# :: BigNat# -> Bool# bigNatIsZero# ba = wordArraySize# ba ==# 0# -- | Indicate if a bigNat is one -bigNatIsOne :: BigNat -> Bool +bigNatIsOne :: BigNat# -> Bool bigNatIsOne bn = isTrue# (bigNatIsOne# bn) -- | Indicate if a bigNat is one -bigNatIsOne# :: BigNat -> Bool# +bigNatIsOne# :: BigNat# -> Bool# bigNatIsOne# ba = wordArraySize# ba ==# 1# &&# indexWordArray# ba 0# `eqWord#` 1## -- | Indicate if a bigNat is two -bigNatIsTwo :: BigNat -> Bool +bigNatIsTwo :: BigNat# -> Bool bigNatIsTwo bn = isTrue# (bigNatIsTwo# bn) -- | Indicate if a bigNat is two -bigNatIsTwo# :: BigNat -> Bool# +bigNatIsTwo# :: BigNat# -> Bool# bigNatIsTwo# ba = wordArraySize# ba ==# 1# &&# indexWordArray# ba 0# `eqWord#` 2## -- | Indicate if the value is a power of two and which one -bigNatIsPowerOf2# :: BigNat -> (# () | Word# #) +bigNatIsPowerOf2# :: BigNat# -> (# () | Word# #) bigNatIsPowerOf2# a | bigNatIsZero a = (# () | #) | True = case wordIsPowerOf2# msw of @@ -155,11 +167,11 @@ bigNatIsPowerOf2# a _ -> 0# -- | Return the Word# at the given index -bigNatIndex# :: BigNat -> Int# -> Word# +bigNatIndex# :: BigNat# -> Int# -> Word# bigNatIndex# x i = indexWordArray# x i -- | Return the Word# at the given index -bigNatIndex :: BigNat -> Int# -> Word +bigNatIndex :: BigNat# -> Int# -> Word bigNatIndex bn i = W# (bigNatIndex# bn i) ------------------------------------------------- @@ -167,16 +179,16 @@ bigNatIndex bn i = W# (bigNatIndex# bn i) ------------------------------------------------- -- | Create a BigNat from a Word -bigNatFromWord :: Word -> BigNat +bigNatFromWord :: Word -> BigNat# bigNatFromWord (W# w) = bigNatFromWord# w -- | Create a BigNat from a Word -bigNatFromWord# :: Word# -> BigNat -bigNatFromWord# 0## = bigNatZero void# +bigNatFromWord# :: Word# -> BigNat# +bigNatFromWord# 0## = bigNatZero# void# bigNatFromWord# w = wordArrayFromWord# w -- | Convert a list of non-zero Words (most-significant first) into a BigNat -bigNatFromWordList :: [Word] -> BigNat +bigNatFromWordList :: [Word] -> BigNat# bigNatFromWordList (W# 0##:xs) = bigNatFromWordList xs bigNatFromWordList xs = bigNatFromWordListUnsafe xs @@ -186,13 +198,13 @@ bigNatFromWordList# :: [Word] -> WordArray# bigNatFromWordList# xs = bigNatFromWordList xs -- | Return the absolute value of the Int# in a BigNat -bigNatFromAbsInt# :: Int# -> BigNat +bigNatFromAbsInt# :: Int# -> BigNat# bigNatFromAbsInt# i = bigNatFromWord# (wordFromAbsInt# i) -- | Convert a list of non-zero Words (most-significant first) into a BigNat. -- Don't remove most-significant zero words -bigNatFromWordListUnsafe :: [Word] -> BigNat -bigNatFromWordListUnsafe [] = bigNatZero void# +bigNatFromWordListUnsafe :: [Word] -> BigNat# +bigNatFromWordListUnsafe [] = bigNatZero# void# bigNatFromWordListUnsafe xs = let length i [] = i @@ -206,7 +218,7 @@ bigNatFromWordListUnsafe xs = writeWordList mwa (lxs -# 1#) xs -- | Convert a BigNat into a list of non-zero Words (most-significant first) -bigNatToWordList :: BigNat -> [Word] +bigNatToWordList :: BigNat# -> [Word] bigNatToWordList bn = go (bigNatSize# bn) where go 0# = [] @@ -214,49 +226,49 @@ bigNatToWordList bn = go (bigNatSize# bn) -- | Convert two Word# (most-significant first) into a BigNat -bigNatFromWord2# :: Word# -> Word# -> BigNat -bigNatFromWord2# 0## 0## = bigNatZero void# +bigNatFromWord2# :: Word# -> Word# -> BigNat# +bigNatFromWord2# 0## 0## = bigNatZero# void# bigNatFromWord2# 0## n = bigNatFromWord# n bigNatFromWord2# w1 w2 = wordArrayFromWord2# w1 w2 -- | Convert a BigNat into a Word# -bigNatToWord# :: BigNat -> Word# +bigNatToWord# :: BigNat# -> Word# bigNatToWord# a | bigNatIsZero a = 0## | True = bigNatIndex# a 0# -- | Convert a BigNat into a Word# if it fits -bigNatToWordMaybe# :: BigNat -> (# Word# | () #) +bigNatToWordMaybe# :: BigNat# -> (# Word# | () #) bigNatToWordMaybe# a | bigNatIsZero a = (# 0## | #) | isTrue# (bigNatSize# a ># 1#) = (# | () #) | True = (# bigNatIndex# a 0# | #) -- | Convert a BigNat into a Word -bigNatToWord :: BigNat -> Word +bigNatToWord :: BigNat# -> Word bigNatToWord bn = W# (bigNatToWord# bn) -- | Convert a BigNat into a Int# -bigNatToInt# :: BigNat -> Int# +bigNatToInt# :: BigNat# -> Int# bigNatToInt# a | bigNatIsZero a = 0# | True = indexIntArray# a 0# -- | Convert a BigNat into a Int -bigNatToInt :: BigNat -> Int +bigNatToInt :: BigNat# -> Int bigNatToInt bn = I# (bigNatToInt# bn) #if WORD_SIZE_IN_BITS == 32 -- | Convert a Word64# into a BigNat on 32-bit architectures -bigNatFromWord64# :: Word64# -> BigNat +bigNatFromWord64# :: Word64# -> BigNat# bigNatFromWord64# w64 = bigNatFromWord2# wh# wl# where wh# = word64ToWord# (uncheckedShiftRL64# w64 32#) wl# = word64ToWord# w64 -- | Convert a BigNat into a Word64# on 32-bit architectures -bigNatToWord64# :: BigNat -> Word64# +bigNatToWord64# :: BigNat# -> Word64# bigNatToWord64# b | bigNatIsZero b = wordToWord64# 0## | wl <- wordToWord64# (bigNatToWord# b) @@ -269,7 +281,7 @@ bigNatToWord64# b #endif -- | Encode (# BigNat mantissa, Int# exponent #) into a Double# -bigNatEncodeDouble# :: BigNat -> Int# -> Double# +bigNatEncodeDouble# :: BigNat# -> Int# -> Double# bigNatEncodeDouble# a e | bigNatIsZero a = word2Double# 0## -- FIXME: isn't it NaN on 0# exponent? @@ -282,7 +294,7 @@ bigNatEncodeDouble# a e ------------------------------------------------- -- | Test if a BigNat is greater than a Word -bigNatGtWord# :: BigNat -> Word# -> Bool# +bigNatGtWord# :: BigNat# -> Word# -> Bool# bigNatGtWord# bn w = notB# (bigNatIsZero# bn) &&# ( bigNatSize# bn ># 1# @@ -290,7 +302,7 @@ bigNatGtWord# bn w = ) -- | Test if a BigNat is equal to a Word -bigNatEqWord# :: BigNat -> Word# -> Bool# +bigNatEqWord# :: BigNat# -> Word# -> Bool# bigNatEqWord# bn w | 0## <- w = bigNatIsZero# bn @@ -302,38 +314,38 @@ bigNatEqWord# bn w = 0# -- | Test if a BigNat is greater than a Word -bigNatGtWord :: BigNat -> Word -> Bool +bigNatGtWord :: BigNat# -> Word -> Bool bigNatGtWord bn (W# w) = isTrue# (bigNatGtWord# bn w) -- | Test if a BigNat is lower than or equal to a Word -bigNatLeWord# :: BigNat -> Word# -> Bool# +bigNatLeWord# :: BigNat# -> Word# -> Bool# bigNatLeWord# bn w = notB# (bigNatGtWord# bn w) -- | Test if a BigNat is lower than or equal to a Word -bigNatLeWord :: BigNat -> Word -> Bool +bigNatLeWord :: BigNat# -> Word -> Bool bigNatLeWord bn (W# w) = isTrue# (bigNatLeWord# bn w) -- | Equality test for BigNat -bigNatEq# :: BigNat -> BigNat -> Bool# +bigNatEq# :: BigNat# -> BigNat# -> Bool# bigNatEq# wa wb | isTrue# (wordArraySize# wa /=# wordArraySize# wb) = 0# | isTrue# (wordArraySize# wa ==# 0#) = 1# | True = inline bignat_compare wa wb ==# 0# -- | Equality test for BigNat -bigNatEq :: BigNat -> BigNat -> Bool +bigNatEq :: BigNat# -> BigNat# -> Bool bigNatEq a b = isTrue# (bigNatEq# a b) -- | Inequality test for BigNat -bigNatNe# :: BigNat -> BigNat -> Bool# +bigNatNe# :: BigNat# -> BigNat# -> Bool# bigNatNe# a b = notB# (bigNatEq# a b) -- | Equality test for BigNat -bigNatNe :: BigNat -> BigNat -> Bool +bigNatNe :: BigNat# -> BigNat# -> Bool bigNatNe a b = isTrue# (bigNatNe# a b) -- | Compare a BigNat and a Word# -bigNatCompareWord# :: BigNat -> Word# -> Ordering +bigNatCompareWord# :: BigNat# -> Word# -> Ordering bigNatCompareWord# a b | bigNatIsZero a = cmpW# 0## b | isTrue# (wordArraySize# a ># 1#) = GT @@ -341,11 +353,11 @@ bigNatCompareWord# a b = cmpW# (indexWordArray# a 1#) b -- | Compare a BigNat and a Word -bigNatCompareWord :: BigNat -> Word -> Ordering +bigNatCompareWord :: BigNat# -> Word -> Ordering bigNatCompareWord a (W# b) = bigNatCompareWord# a b -- | Compare two BigNat -bigNatCompare :: BigNat -> BigNat -> Ordering +bigNatCompare :: BigNat# -> BigNat# -> Ordering bigNatCompare a b = let szA = wordArraySize# a @@ -358,7 +370,7 @@ bigNatCompare a b = -- | Predicate: a < b -bigNatLt :: BigNat -> BigNat -> Bool +bigNatLt :: BigNat# -> BigNat# -> Bool bigNatLt a b = bigNatCompare a b == LT ------------------------------------------------- @@ -366,7 +378,7 @@ bigNatLt a b = bigNatCompare a b == LT ------------------------------------------------- -- | Add a bigNat and a Word# -bigNatAddWord# :: BigNat -> Word# -> BigNat +bigNatAddWord# :: BigNat# -> Word# -> BigNat# bigNatAddWord# a b | 0## <- b = a @@ -379,11 +391,11 @@ bigNatAddWord# a b inline bignat_add_word mwa a b s -- | Add a bigNat and a Word -bigNatAddWord :: BigNat -> Word -> BigNat +bigNatAddWord :: BigNat# -> Word -> BigNat# bigNatAddWord a (W# b) = bigNatAddWord# a b -- | Add two bigNats -bigNatAdd :: BigNat -> BigNat -> BigNat +bigNatAdd :: BigNat# -> BigNat# -> BigNat# bigNatAdd a b | bigNatIsZero a = b | bigNatIsZero b = a @@ -401,11 +413,11 @@ bigNatAdd a b ------------------------------------------------- -- | Multiply a BigNat by a Word# -bigNatMulWord# :: BigNat -> Word# -> BigNat +bigNatMulWord# :: BigNat# -> Word# -> BigNat# bigNatMulWord# a w - | 0## <- w = bigNatZero void# + | 0## <- w = bigNatZero# void# | 1## <- w = a - | bigNatIsZero a = bigNatZero void# + | bigNatIsZero a = bigNatZero# void# | bigNatIsOne a = bigNatFromWord# w | isTrue# (bigNatSize# a ==# 1#) = case timesWord2# (bigNatIndex# a 0#) w of @@ -414,17 +426,17 @@ bigNatMulWord# a w inline bignat_mul_word mwa a w s -- | Multiply a BigNAt by a Word -bigNatMulWord :: BigNat -> Word -> BigNat +bigNatMulWord :: BigNat# -> Word -> BigNat# bigNatMulWord a (W# w) = bigNatMulWord# a w -- | Square a BigNat -bigNatSqr :: BigNat -> BigNat +bigNatSqr :: BigNat# -> BigNat# bigNatSqr a = bigNatMul a a -- This can be replaced by a backend primitive in the future (e.g. to use -- GMP's mpn_sqr) -- | Multiplication (classical algorithm) -bigNatMul :: BigNat -> BigNat -> BigNat +bigNatMul :: BigNat# -> BigNat# -> BigNat# bigNatMul a b | bigNatSize b > bigNatSize a = bigNatMul b a -- optimize loops | bigNatIsZero a = a @@ -447,7 +459,7 @@ bigNatMul a b -- | Subtract a Word# from a BigNat -- -- The BigNat must be bigger than the Word#. -bigNatSubWordUnsafe# :: BigNat -> Word# -> BigNat +bigNatSubWordUnsafe# :: BigNat# -> Word# -> BigNat# bigNatSubWordUnsafe# x y | 0## <- y = x | True = withNewWordArrayTrimed# sz \mwa -> go mwa y 0# @@ -469,11 +481,11 @@ bigNatSubWordUnsafe# x y -- | Subtract a Word# from a BigNat -- -- The BigNat must be bigger than the Word#. -bigNatSubWordUnsafe :: BigNat -> Word -> BigNat +bigNatSubWordUnsafe :: BigNat# -> Word -> BigNat# bigNatSubWordUnsafe x (W# y) = bigNatSubWordUnsafe# x y -- | Subtract a Word# from a BigNat -bigNatSubWord# :: BigNat -> Word# -> (# () | BigNat #) +bigNatSubWord# :: BigNat# -> Word# -> (# () | BigNat# #) bigNatSubWord# a b | 0## <- b = (# | a #) | bigNatIsZero a = (# () | #) @@ -483,7 +495,7 @@ bigNatSubWord# a b -- | Subtract two BigNat (don't check if a >= b) -bigNatSubUnsafe :: BigNat -> BigNat -> BigNat +bigNatSubUnsafe :: BigNat# -> BigNat# -> BigNat# bigNatSubUnsafe a b | bigNatIsZero b = a | True = @@ -497,7 +509,7 @@ bigNatSubUnsafe a b -- GHC.Num.Primitives -- | Subtract two BigNat -bigNatSub :: BigNat -> BigNat -> (# () | BigNat #) +bigNatSub :: BigNat# -> BigNat# -> (# () | BigNat# #) bigNatSub a b | bigNatIsZero b = (# | a #) | isTrue# (bigNatSize# a <# bigNatSize# b) @@ -516,7 +528,7 @@ bigNatSub a b -- -- Require: -- b /= 0 -bigNatQuotWord# :: BigNat -> Word# -> BigNat +bigNatQuotWord# :: BigNat# -> Word# -> BigNat# bigNatQuotWord# a b | 1## <- b = a | 0## <- b = raiseDivZero_BigNat void# @@ -530,14 +542,14 @@ bigNatQuotWord# a b -- -- Require: -- b /= 0 -bigNatQuotWord :: BigNat -> Word -> BigNat +bigNatQuotWord :: BigNat# -> Word -> BigNat# bigNatQuotWord a (W# b) = bigNatQuotWord# a b -- | Divide a BigNat by a Word, return the remainder -- -- Require: -- b /= 0 -bigNatRemWord# :: BigNat -> Word# -> Word# +bigNatRemWord# :: BigNat# -> Word# -> Word# bigNatRemWord# a b | 0## <- b = raiseDivZero_Word# void# | 1## <- b = 0## @@ -548,24 +560,24 @@ bigNatRemWord# a b -- -- Require: -- b /= 0 -bigNatRemWord :: BigNat -> Word -> Word +bigNatRemWord :: BigNat# -> Word -> Word bigNatRemWord a (W# b) = W# (bigNatRemWord# a b) -- | QuotRem a BigNat by a Word -- -- Require: -- b /= 0 -bigNatQuotRemWord# :: BigNat -> Word# -> (# BigNat, Word# #) +bigNatQuotRemWord# :: BigNat# -> Word# -> (# BigNat#, Word# #) bigNatQuotRemWord# a b | 0## <- b = case raiseDivZero of - !_ -> (# bigNatZero void#, 0## #) + !_ -> (# bigNatZero# void#, 0## #) -- see Note [ghc-bignum exceptions] in GHC.Num.Primitives | 1## <- b = (# a, 0## #) | isTrue# (bigNatSize# a ==# 1#) , a0 <- indexWordArray# a 0# = case compareWord# a0 b of - LT -> (# bigNatZero void#, a0 #) - EQ -> (# bigNatOne void#, 0## #) + LT -> (# bigNatZero# void#, a0 #) + EQ -> (# bigNatOne# void#, 0## #) GT -> case quotRemWord# a0 b of (# q, r #) -> (# bigNatFromWord# q, r #) | True = @@ -583,15 +595,15 @@ bigNatQuotRemWord# a b -- | BigNat division returning (quotient,remainder) -bigNatQuotRem# :: BigNat -> BigNat -> (# BigNat,BigNat #) +bigNatQuotRem# :: BigNat# -> BigNat# -> (# BigNat#, BigNat# #) bigNatQuotRem# a b | bigNatIsZero b = case raiseDivZero of - !_ -> (# bigNatZero void#, bigNatZero void# #) + !_ -> (# bigNatZero# void#, bigNatZero# void# #) -- see Note [ghc-bignum exceptions] in GHC.Num.Primitives - | bigNatIsZero a = (# bigNatZero void#, bigNatZero void# #) - | bigNatIsOne b = (# a , bigNatZero void# #) - | LT <- cmp = (# bigNatZero void#, a #) - | EQ <- cmp = (# bigNatOne void#, bigNatZero void# #) + | bigNatIsZero a = (# bigNatZero# void#, bigNatZero# void# #) + | bigNatIsOne b = (# a , bigNatZero# void# #) + | LT <- cmp = (# bigNatZero# void#, a #) + | EQ <- cmp = (# bigNatOne# void#, bigNatZero# void# #) | isTrue# (szB ==# 1#) = case bigNatQuotRemWord# a (bigNatIndex# b 0#) of (# q, r #) -> (# q, bigNatFromWord# r #) @@ -606,13 +618,13 @@ bigNatQuotRem# a b -- | BigNat division returning quotient -bigNatQuot :: BigNat -> BigNat -> BigNat +bigNatQuot :: BigNat# -> BigNat# -> BigNat# bigNatQuot a b | bigNatIsZero b = raiseDivZero_BigNat void# - | bigNatIsZero a = bigNatZero void# + | bigNatIsZero a = bigNatZero# void# | bigNatIsOne b = a - | LT <- cmp = bigNatZero void# - | EQ <- cmp = bigNatOne void# + | LT <- cmp = bigNatZero# void# + | EQ <- cmp = bigNatOne# void# | isTrue# (szB ==# 1#) = bigNatQuotWord# a (bigNatIndex# b 0#) | True = withNewWordArrayTrimed# szQ \mwq s -> inline bignat_quot mwq a b s @@ -623,13 +635,13 @@ bigNatQuot a b szQ = 1# +# szA -# szB -- | BigNat division returning remainder -bigNatRem :: BigNat -> BigNat -> BigNat +bigNatRem :: BigNat# -> BigNat# -> BigNat# bigNatRem a b | bigNatIsZero b = raiseDivZero_BigNat void# - | bigNatIsZero a = bigNatZero void# - | bigNatIsOne b = bigNatZero void# + | bigNatIsZero a = bigNatZero# void# + | bigNatIsOne b = bigNatZero# void# | LT <- cmp = a - | EQ <- cmp = bigNatZero void# + | EQ <- cmp = bigNatZero# void# | isTrue# (szB ==# 1#) = case bigNatRemWord# a (bigNatIndex# b 0#) of r -> bigNatFromWord# r | True = withNewWordArrayTrimed# szR \mwr s -> @@ -671,7 +683,7 @@ gcdInt :: Int -> Int -> Int gcdInt (I# x) (I# y) = I# (gcdInt# x y) -- | Greatest common divisor -bigNatGcd :: BigNat -> BigNat -> BigNat +bigNatGcd :: BigNat# -> BigNat# -> BigNat# bigNatGcd a b | bigNatIsZero a = b | bigNatIsZero b = a @@ -694,7 +706,7 @@ bigNatGcd a b GT -> go a b -- | Greatest common divisor -bigNatGcdWord# :: BigNat -> Word# -> Word# +bigNatGcdWord# :: BigNat# -> Word# -> Word# bigNatGcdWord# a b | bigNatIsZero a = 0## | 0## <- b = 0## @@ -705,10 +717,10 @@ bigNatGcdWord# a b _ -> bignat_gcd_word a b -- | Least common multiple -bigNatLcm :: BigNat -> BigNat -> BigNat +bigNatLcm :: BigNat# -> BigNat# -> BigNat# bigNatLcm a b - | bigNatIsZero a = bigNatZero void# - | bigNatIsZero b = bigNatZero void# + | bigNatIsZero a = bigNatZero# void# + | bigNatIsZero b = bigNatZero# void# | bigNatIsOne a = b | bigNatIsOne b = a | True @@ -720,10 +732,10 @@ bigNatLcm a b -- TODO: use extended GCD to get a's factor directly -- | Least common multiple with a Word# -bigNatLcmWord# :: BigNat -> Word# -> BigNat +bigNatLcmWord# :: BigNat# -> Word# -> BigNat# bigNatLcmWord# a b - | bigNatIsZero a = bigNatZero void# - | 0## <- b = bigNatZero void# + | bigNatIsZero a = bigNatZero# void# + | 0## <- b = bigNatZero# void# | bigNatIsOne a = bigNatFromWord# b | 1## <- b = a | 1# <- bigNatSize# a = bigNatLcmWordWord# (bigNatIndex# a 0#) b @@ -732,10 +744,10 @@ bigNatLcmWord# a b -- TODO: use extended GCD to get a's factor directly -- | Least common multiple between two Word# -bigNatLcmWordWord# :: Word# -> Word# -> BigNat +bigNatLcmWordWord# :: Word# -> Word# -> BigNat# bigNatLcmWordWord# a b - | 0## <- a = bigNatZero void# - | 0## <- b = bigNatZero void# + | 0## <- a = bigNatZero# void# + | 0## <- b = bigNatZero# void# | 1## <- a = bigNatFromWord# b | 1## <- b = bigNatFromWord# a | True = case (a `quotWord#` (a `gcdWord#` b)) `timesWord2#` b of @@ -748,7 +760,7 @@ bigNatLcmWordWord# a b ------------------------------------------------- -- | Bitwise OR -bigNatOr :: BigNat -> BigNat -> BigNat +bigNatOr :: BigNat# -> BigNat# -> BigNat# bigNatOr a b | bigNatIsZero a = b | bigNatIsZero b = a @@ -760,7 +772,7 @@ bigNatOr a b !sz = maxI# szA szB -- | Bitwise OR with Word# -bigNatOrWord# :: BigNat -> Word# -> BigNat +bigNatOrWord# :: BigNat# -> Word# -> BigNat# bigNatOrWord# a b | bigNatIsZero a = bigNatFromWord# b | 0## <- b = a @@ -771,7 +783,7 @@ bigNatOrWord# a b s' -> mwaWrite# mwa 0# (indexWordArray# a 0# `or#` b) s' -- | Bitwise AND -bigNatAnd :: BigNat -> BigNat -> BigNat +bigNatAnd :: BigNat# -> BigNat# -> BigNat# bigNatAnd a b | bigNatIsZero a = a | bigNatIsZero b = b @@ -783,7 +795,7 @@ bigNatAnd a b !sz = minI# szA szB -- | Bitwise ANDNOT -bigNatAndNot :: BigNat -> BigNat -> BigNat +bigNatAndNot :: BigNat# -> BigNat# -> BigNat# bigNatAndNot a b | bigNatIsZero a = a | bigNatIsZero b = a @@ -793,13 +805,13 @@ bigNatAndNot a b !szA = wordArraySize# a -- | Bitwise AND with Word# -bigNatAndWord# :: BigNat -> Word# -> BigNat +bigNatAndWord# :: BigNat# -> Word# -> BigNat# bigNatAndWord# a b | bigNatIsZero a = a | True = bigNatFromWord# (indexWordArray# a 0# `and#` b) -- | Bitwise ANDNOT with Word# -bigNatAndNotWord# :: BigNat -> Word# -> BigNat +bigNatAndNotWord# :: BigNat# -> Word# -> BigNat# bigNatAndNotWord# a b | bigNatIsZero a = a | szA <- bigNatSize# a @@ -810,7 +822,7 @@ bigNatAndNotWord# a b (indexWordArray# a 0# `and#` not# b) s' -- | Bitwise AND with Int# -bigNatAndInt# :: BigNat -> Int# -> BigNat +bigNatAndInt# :: BigNat# -> Int# -> BigNat# bigNatAndInt# a b | bigNatIsZero a = a | isTrue# (b >=# 0#) = bigNatAndWord# a (int2Word# b) @@ -823,7 +835,7 @@ bigNatAndInt# a b -- | Bitwise XOR -bigNatXor :: BigNat -> BigNat -> BigNat +bigNatXor :: BigNat# -> BigNat# -> BigNat# bigNatXor a b | bigNatIsZero a = b | bigNatIsZero b = a @@ -835,7 +847,7 @@ bigNatXor a b !sz = maxI# szA szB -- | Bitwise XOR with Word# -bigNatXorWord# :: BigNat -> Word# -> BigNat +bigNatXorWord# :: BigNat# -> Word# -> BigNat# bigNatXorWord# a b | bigNatIsZero a = bigNatFromWord# b | 0## <- b = a @@ -847,17 +859,17 @@ bigNatXorWord# a b s' -> mwaWrite# mwa 0# (indexWordArray# a 0# `xor#` b) s' -- | PopCount for BigNat -bigNatPopCount :: BigNat -> Word +bigNatPopCount :: BigNat# -> Word bigNatPopCount a = W# (bigNatPopCount# a) -- | PopCount for BigNat -bigNatPopCount# :: BigNat -> Word# +bigNatPopCount# :: BigNat# -> Word# bigNatPopCount# a | bigNatIsZero a = 0## | True = inline bignat_popcount a -- | Bit shift right -bigNatShiftR# :: BigNat -> Word# -> BigNat +bigNatShiftR# :: BigNat# -> Word# -> BigNat# bigNatShiftR# a n | 0## <- n = a @@ -867,7 +879,7 @@ bigNatShiftR# a n | nw <- word2Int# (n `uncheckedShiftRL#` WORD_SIZE_BITS_SHIFT#) , isTrue# (nw >=# wordArraySize# a) - = bigNatZero void# + = bigNatZero# void# | True = let @@ -878,7 +890,7 @@ bigNatShiftR# a n inline bignat_shiftr mwa a n s -- | Bit shift right (two's complement) -bigNatShiftRNeg# :: BigNat -> Word# -> BigNat +bigNatShiftRNeg# :: BigNat# -> Word# -> BigNat# bigNatShiftRNeg# a n | 0## <- n = a @@ -888,7 +900,7 @@ bigNatShiftRNeg# a n | nw <- word2Int# (n `uncheckedShiftRL#` WORD_SIZE_BITS_SHIFT#) , isTrue# (nw >=# wordArraySize# a) - = bigNatZero void# + = bigNatZero# void# | True = let @@ -900,15 +912,15 @@ bigNatShiftRNeg# a n -- | Bit shift right -bigNatShiftR :: BigNat -> Word -> BigNat +bigNatShiftR :: BigNat# -> Word -> BigNat# bigNatShiftR a (W# n) = bigNatShiftR# a n -- | Bit shift left -bigNatShiftL :: BigNat -> Word -> BigNat +bigNatShiftL :: BigNat# -> Word -> BigNat# bigNatShiftL a (W# n) = bigNatShiftL# a n -- | Bit shift left -bigNatShiftL# :: BigNat -> Word# -> BigNat +bigNatShiftL# :: BigNat# -> Word# -> BigNat# bigNatShiftL# a n | 0## <- n = a @@ -928,7 +940,7 @@ bigNatShiftL# a n -- | BigNat bit test -bigNatTestBit# :: BigNat -> Word# -> Bool# +bigNatTestBit# :: BigNat# -> Word# -> Bool# bigNatTestBit# a n = let !sz = wordArraySize# a @@ -939,7 +951,7 @@ bigNatTestBit# a n = | True -> testBitW# (indexWordArray# a nw) nb -- | BigNat bit test -bigNatTestBit :: BigNat -> Word -> Bool +bigNatTestBit :: BigNat# -> Word -> Bool bigNatTestBit a (W# n) = isTrue# (bigNatTestBit# a n) @@ -947,9 +959,9 @@ bigNatTestBit a (W# n) = isTrue# (bigNatTestBit# a n) -- -- Specialized version of `bigNatShiftL (bigNatFromWord# 1##)` -- -bigNatBit# :: Word# -> BigNat +bigNatBit# :: Word# -> BigNat# bigNatBit# i - | 0## <- i = bigNatOne void# + | 0## <- i = bigNatOne# void# | True = let !nw = word2Int# (i `uncheckedShiftRL#` WORD_SIZE_BITS_SHIFT#) @@ -966,11 +978,11 @@ bigNatBit# i -- -- Specialized version of `bigNatShiftL (bigNatFromWord# 1##)` -- -bigNatBit :: Word -> BigNat +bigNatBit :: Word -> BigNat# bigNatBit (W# i) = bigNatBit# i -- | BigNat clear bit -bigNatClearBit# :: BigNat -> Word# -> BigNat +bigNatClearBit# :: BigNat# -> Word# -> BigNat# bigNatClearBit# a n -- check the range validity and the current bit value | isTrue# (bigNatTestBit# a n ==# 0#) = a @@ -988,7 +1000,7 @@ bigNatClearBit# a n | 0## <- nv , isTrue# (nw +# 1# ==# sz) -> case sz -# (waClzAt a (sz -# 2#) +# 1#) of - 0# -> bigNatZero void# + 0# -> bigNatZero# void# nsz -> withNewWordArray# nsz \mwa s -> mwaArrayCopy# mwa 0# a 0# nsz s @@ -998,7 +1010,7 @@ bigNatClearBit# a n s' -> writeWordArray# mwa nw nv s' -- | BigNat set bit -bigNatSetBit# :: BigNat -> Word# -> BigNat +bigNatSetBit# :: BigNat# -> Word# -> BigNat# bigNatSetBit# a n -- check the current bit value | isTrue# (bigNatTestBit# a n) = a @@ -1022,7 +1034,7 @@ bigNatSetBit# a n s' -> writeWordArray# mwa nw nv s' -- | Reverse the given bit -bigNatComplementBit# :: BigNat -> Word# -> BigNat +bigNatComplementBit# :: BigNat# -> Word# -> BigNat# bigNatComplementBit# bn i | isTrue# (bigNatTestBit# bn i) = bigNatClearBit# bn i | True = bigNatSetBit# bn i @@ -1032,7 +1044,7 @@ bigNatComplementBit# bn i ------------------------------------------------- -- | Base 2 logarithm -bigNatLog2# :: BigNat -> Word# +bigNatLog2# :: BigNat# -> Word# bigNatLog2# a | bigNatIsZero a = 0## | True = @@ -1041,11 +1053,11 @@ bigNatLog2# a `plusWord#` (i `uncheckedShiftL#` WORD_SIZE_BITS_SHIFT#) -- | Base 2 logarithm -bigNatLog2 :: BigNat -> Word +bigNatLog2 :: BigNat# -> Word bigNatLog2 a = W# (bigNatLog2# a) -- | Logarithm for an arbitrary base -bigNatLogBase# :: BigNat -> BigNat -> Word# +bigNatLogBase# :: BigNat# -> BigNat# -> Word# bigNatLogBase# base a | bigNatIsZero base || bigNatIsOne base = unexpectedValue_Word# void# @@ -1068,11 +1080,11 @@ bigNatLogBase# base a , (2## `timesWord#` e) `plusWord#` 1## #) -- | Logarithm for an arbitrary base -bigNatLogBase :: BigNat -> BigNat -> Word +bigNatLogBase :: BigNat# -> BigNat# -> Word bigNatLogBase base a = W# (bigNatLogBase# base a) -- | Logarithm for an arbitrary base -bigNatLogBaseWord# :: Word# -> BigNat -> Word# +bigNatLogBaseWord# :: Word# -> BigNat# -> Word# bigNatLogBaseWord# base a | 0## <- base = unexpectedValue_Word# void# | 1## <- base = unexpectedValue_Word# void# @@ -1081,7 +1093,7 @@ bigNatLogBaseWord# base a | True = bigNatLogBase# (bigNatFromWord# base) a -- | Logarithm for an arbitrary base -bigNatLogBaseWord :: Word -> BigNat -> Word +bigNatLogBaseWord :: Word -> BigNat# -> Word bigNatLogBaseWord (W# base) a = W# (bigNatLogBaseWord# base a) ------------------------------------------------- @@ -1091,7 +1103,7 @@ bigNatLogBaseWord (W# base) a = W# (bigNatLogBaseWord# base a) -- | Compute the number of digits of the BigNat in the given base. -- -- `base` must be > 1 -bigNatSizeInBase# :: Word# -> BigNat -> Word# +bigNatSizeInBase# :: Word# -> BigNat# -> Word# bigNatSizeInBase# base a | isTrue# (base `leWord#` 1##) = unexpectedValue_Word# void# @@ -1105,7 +1117,7 @@ bigNatSizeInBase# base a -- | Compute the number of digits of the BigNat in the given base. -- -- `base` must be > 1 -bigNatSizeInBase :: Word -> BigNat -> Word +bigNatSizeInBase :: Word -> BigNat# -> Word bigNatSizeInBase (W# w) a = W# (bigNatSizeInBase# w a) ------------------------------------------------- @@ -1122,7 +1134,7 @@ powModWord# = bignat_powmod_words -- | \"@'bigNatPowModWord#' /b/ /e/ /m/@\" computes base @/b/@ raised to -- exponent @/e/@ modulo @/m/@. -bigNatPowModWord# :: BigNat -> BigNat -> Word# -> Word# +bigNatPowModWord# :: BigNat# -> BigNat# -> Word# -> Word# bigNatPowModWord# !_ !_ 0## = raiseDivZero_Word# void# bigNatPowModWord# _ _ 1## = 0## bigNatPowModWord# b e m @@ -1133,7 +1145,7 @@ bigNatPowModWord# b e m -- | \"@'bigNatPowMod' /b/ /e/ /m/@\" computes base @/b/@ raised to -- exponent @/e/@ modulo @/m/@. -bigNatPowMod :: BigNat -> BigNat -> BigNat -> BigNat +bigNatPowMod :: BigNat# -> BigNat# -> BigNat# -> BigNat# bigNatPowMod !b !e !m | (# m' | #) <- bigNatToWordMaybe# m = bigNatFromWord# (bigNatPowModWord# b e m') @@ -1148,7 +1160,7 @@ bigNatPowMod !b !e !m -- | Return count of trailing zero bits -- -- Return 0 for zero BigNat -bigNatCtz# :: BigNat -> Word# +bigNatCtz# :: BigNat# -> Word# bigNatCtz# a | bigNatIsZero a = 0## | True = go 0# 0## @@ -1160,14 +1172,14 @@ bigNatCtz# a -- | Return count of trailing zero bits -- -- Return 0 for zero BigNat -bigNatCtz :: BigNat -> Word +bigNatCtz :: BigNat# -> Word bigNatCtz a = W# (bigNatCtz# a) -- | Return count of trailing zero words -- -- Return 0 for zero BigNat -bigNatCtzWord# :: BigNat -> Word# +bigNatCtzWord# :: BigNat# -> Word# bigNatCtzWord# a | bigNatIsZero a = 0## | True = go 0# 0## @@ -1179,7 +1191,7 @@ bigNatCtzWord# a -- | Return count of trailing zero words -- -- Return 0 for zero BigNat -bigNatCtzWord :: BigNat -> Word +bigNatCtzWord :: BigNat# -> Word bigNatCtzWord a = W# (bigNatCtzWord# a) ------------------------------------------------- @@ -1192,7 +1204,7 @@ bigNatCtzWord a = W# (bigNatCtzWord# a) -- Use \"@'bigNatSizeInBase' 256# /i/@\" to compute the exact number of bytes -- written in advance. In case of @/i/ == 0@, the function will write and report -- zero bytes written. -bigNatToAddrLE# :: BigNat -> Addr# -> State# s -> (# State# s, Word# #) +bigNatToAddrLE# :: BigNat# -> Addr# -> State# s -> (# State# s, Word# #) bigNatToAddrLE# a addr s0 | isTrue# (sz ==# 0#) = (# s0, 0## #) | True = case writeMSB s0 of @@ -1221,7 +1233,7 @@ bigNatToAddrLE# a addr s0 -- Use \"@'bigNatSizeInBase' 256# /i/@\" to compute the exact number of bytes -- written in advance. In case of @/i/ == 0@, the function will write and report -- zero bytes written. -bigNatToAddrBE# :: BigNat -> Addr# -> State# s -> (# State# s, Word# #) +bigNatToAddrBE# :: BigNat# -> Addr# -> State# s -> (# State# s, Word# #) bigNatToAddrBE# a addr s0 | isTrue# (sz ==# 0#) = (# s0, 0## #) | msw <- indexWordArray# a (sz -# 1#) @@ -1251,7 +1263,7 @@ bigNatToAddrBE# a addr s0 -- Use \"@'bigNatSizeInBase' 256# /i/@\" to compute the exact number of bytes -- written in advance. In case of @/i/ == 0@, the function will write and report -- zero bytes written. -bigNatToAddr# :: BigNat -> Addr# -> Bool# -> State# s -> (# State# s, Word# #) +bigNatToAddr# :: BigNat# -> Addr# -> Bool# -> State# s -> (# State# s, Word# #) bigNatToAddr# a addr 0# s = bigNatToAddrLE# a addr s bigNatToAddr# a addr _ s = bigNatToAddrBE# a addr s @@ -1265,7 +1277,7 @@ bigNatToAddr# a addr _ s = bigNatToAddrBE# a addr s -- Use \"@'bigNatSizeInBase' 256# /i/@\" to compute the exact number of bytes -- written in advance. In case of @/i/ == 0@, the function will write and report -- zero bytes written. -bigNatToAddr :: BigNat -> Addr# -> Bool# -> IO Word +bigNatToAddr :: BigNat# -> Addr# -> Bool# -> IO Word bigNatToAddr a addr e = IO \s -> case bigNatToAddr# a addr e s of (# s', w #) -> (# s', W# w #) @@ -1280,8 +1292,8 @@ bigNatToAddr a addr e = IO \s -> case bigNatToAddr# a addr e s of -- The size is given in bytes. -- -- Higher limbs equal to 0 are automatically trimed. -bigNatFromAddrLE# :: Word# -> Addr# -> State# s -> (# State# s, BigNat #) -bigNatFromAddrLE# 0## _ s = (# s, bigNatZero void# #) +bigNatFromAddrLE# :: Word# -> Addr# -> State# s -> (# State# s, BigNat# #) +bigNatFromAddrLE# 0## _ s = (# s, bigNatZero# void# #) bigNatFromAddrLE# sz addr s = let !nw = sz `uncheckedShiftRL#` WORD_SIZE_BYTES_SHIFT# @@ -1315,8 +1327,8 @@ bigNatFromAddrLE# sz addr s = -- The size is given in bytes. -- -- Null higher limbs are automatically trimed. -bigNatFromAddrBE# :: Word# -> Addr# -> State# s -> (# State# s, BigNat #) -bigNatFromAddrBE# 0## _ s = (# s, bigNatZero void# #) +bigNatFromAddrBE# :: Word# -> Addr# -> State# s -> (# State# s, BigNat# #) +bigNatFromAddrBE# 0## _ s = (# s, bigNatZero# void# #) bigNatFromAddrBE# sz addr s = let !nw = word2Int# (sz `uncheckedShiftRL#` WORD_SIZE_BYTES_SHIFT#) @@ -1355,7 +1367,7 @@ bigNatFromAddrBE# sz addr s = -- (little-endian) if @0#@. -- -- Null higher limbs are automatically trimed. -bigNatFromAddr# :: Word# -> Addr# -> Bool# -> State# s -> (# State# s, BigNat #) +bigNatFromAddr# :: Word# -> Addr# -> Bool# -> State# s -> (# State# s, BigNat# #) bigNatFromAddr# sz addr 0# s = bigNatFromAddrLE# sz addr s bigNatFromAddr# sz addr _ s = bigNatFromAddrBE# sz addr s @@ -1369,7 +1381,7 @@ bigNatFromAddr# sz addr _ s = bigNatFromAddrBE# sz addr s -- Use \"@'bigNatSizeInBase' 256# /i/@\" to compute the exact number of bytes -- written in advance. In case of @/i/ == 0@, the function will write and report -- zero bytes written. -bigNatToMutableByteArrayLE# :: BigNat -> MutableByteArray# s -> Word# -> State# s -> (# State# s, Word# #) +bigNatToMutableByteArrayLE# :: BigNat# -> MutableByteArray# s -> Word# -> State# s -> (# State# s, Word# #) bigNatToMutableByteArrayLE# a mba moff s0 | isTrue# (sz ==# 0#) = (# s0, 0## #) | True = case writeMSB s0 of @@ -1398,7 +1410,7 @@ bigNatToMutableByteArrayLE# a mba moff s0 -- Use \"@'bigNatSizeInBase' 256# /i/@\" to compute the exact number of bytes -- written in advance. In case of @/i/ == 0@, the function will write and report -- zero bytes written. -bigNatToMutableByteArrayBE# :: BigNat -> MutableByteArray# s -> Word# -> State# s -> (# State# s, Word# #) +bigNatToMutableByteArrayBE# :: BigNat# -> MutableByteArray# s -> Word# -> State# s -> (# State# s, Word# #) bigNatToMutableByteArrayBE# a mba moff s0 | isTrue# (sz ==# 0#) = (# s0, 0## #) | msw <- indexWordArray# a (sz -# 1#) @@ -1428,7 +1440,7 @@ bigNatToMutableByteArrayBE# a mba moff s0 -- Use \"@'bigNatSizeInBase' 256# /i/@\" to compute the exact number of bytes -- written in advance. In case of @/i/ == 0@, the function will write and report -- zero bytes written. -bigNatToMutableByteArray# :: BigNat -> MutableByteArray# s -> Word# -> Bool# -> State# s -> (# State# s, Word# #) +bigNatToMutableByteArray# :: BigNat# -> MutableByteArray# s -> Word# -> Bool# -> State# s -> (# State# s, Word# #) bigNatToMutableByteArray# a mba off 0# s = bigNatToMutableByteArrayLE# a mba off s bigNatToMutableByteArray# a mba off _ s = bigNatToMutableByteArrayBE# a mba off s @@ -1441,8 +1453,8 @@ bigNatToMutableByteArray# a mba off _ s = bigNatToMutableByteArrayBE# a mba off -- The size is given in bytes. -- -- Null higher limbs are automatically trimed. -bigNatFromByteArrayLE# :: Word# -> ByteArray# -> Word# -> State# s -> (# State# s, BigNat #) -bigNatFromByteArrayLE# 0## _ _ s = (# s, bigNatZero void# #) +bigNatFromByteArrayLE# :: Word# -> ByteArray# -> Word# -> State# s -> (# State# s, BigNat# #) +bigNatFromByteArrayLE# 0## _ _ s = (# s, bigNatZero# void# #) bigNatFromByteArrayLE# sz ba moff s = let !nw = sz `uncheckedShiftRL#` WORD_SIZE_BYTES_SHIFT# @@ -1476,8 +1488,8 @@ bigNatFromByteArrayLE# sz ba moff s = -- The size is given in bytes. -- -- Null higher limbs are automatically trimed. -bigNatFromByteArrayBE# :: Word# -> ByteArray# -> Word# -> State# s -> (# State# s, BigNat #) -bigNatFromByteArrayBE# 0## _ _ s = (# s, bigNatZero void# #) +bigNatFromByteArrayBE# :: Word# -> ByteArray# -> Word# -> State# s -> (# State# s, BigNat# #) +bigNatFromByteArrayBE# 0## _ _ s = (# s, bigNatZero# void# #) bigNatFromByteArrayBE# sz ba moff s = let !nw = sz `uncheckedShiftRL#` WORD_SIZE_BYTES_SHIFT# @@ -1516,6 +1528,6 @@ bigNatFromByteArrayBE# sz ba moff s = -- (little-endian) if @0#@. -- -- Null higher limbs are automatically trimed. -bigNatFromByteArray# :: Word# -> ByteArray# -> Word# -> Bool# -> State# s -> (# State# s, BigNat #) +bigNatFromByteArray# :: Word# -> ByteArray# -> Word# -> Bool# -> State# s -> (# State# s, BigNat# #) bigNatFromByteArray# sz ba off 0# s = bigNatFromByteArrayLE# sz ba off s bigNatFromByteArray# sz ba off _ s = bigNatFromByteArrayBE# sz ba off s diff --git a/libraries/ghc-bignum/src/GHC/Num/BigNat/Native.hs b/libraries/ghc-bignum/src/GHC/Num/BigNat/Native.hs index a25b36eaec..2d06a730a0 100644 --- a/libraries/ghc-bignum/src/GHC/Num/BigNat/Native.hs +++ b/libraries/ghc-bignum/src/GHC/Num/BigNat/Native.hs @@ -665,7 +665,7 @@ bignat_encode_double wa e0 = go 0.0## e0 0# (i +# 1#) bignat_powmod_word :: WordArray# -> WordArray# -> Word# -> Word# -bignat_powmod_word b0 e0 m = go (naturalFromBigNat b0) (naturalFromBigNat e0) (naturalFromWord# 1##) +bignat_powmod_word b0 e0 m = go (naturalFromBigNat# b0) (naturalFromBigNat# e0) (naturalFromWord# 1##) where go !b e !r | isTrue# (e `naturalTestBit#` 0##) @@ -690,8 +690,8 @@ bignat_powmod -> State# RealWorld bignat_powmod r b0 e0 m s = mwaInitCopyShrink# r r' s where - !r' = go (naturalFromBigNat b0) - (naturalFromBigNat e0) + !r' = go (naturalFromBigNat# b0) + (naturalFromBigNat# e0) (naturalFromWord# 1##) go !b e !r @@ -699,13 +699,13 @@ bignat_powmod r b0 e0 m s = mwaInitCopyShrink# r r' s = go b' e' ((r `naturalMul` b) `naturalRem` m') | naturalIsZero e - = naturalToBigNat r + = naturalToBigNat# r | True = go b' e' r where b' = (b `naturalMul` b) `naturalRem` m' - m' = naturalFromBigNat m + m' = naturalFromBigNat# m e' = e `naturalShiftR#` 1## -- slightly faster than "e `div` 2" bignat_powmod_words diff --git a/libraries/ghc-bignum/src/GHC/Num/Integer.hs b/libraries/ghc-bignum/src/GHC/Num/Integer.hs index 82c109c5f7..57bb8dbadf 100644 --- a/libraries/ghc-bignum/src/GHC/Num/Integer.hs +++ b/libraries/ghc-bignum/src/GHC/Num/Integer.hs @@ -51,9 +51,9 @@ default () -- -- Invariant: 'IP' and 'IN' are used iff value doesn't fit in 'IS' data Integer - = IS !Int# -- ^ iff value in @[minBound::'Int', maxBound::'Int']@ range - | IP !BigNat -- ^ iff value in @]maxBound::'Int', +inf[@ range - | IN !BigNat -- ^ iff value in @]-inf, minBound::'Int'[@ range + = IS !Int# -- ^ iff value in @[minBound::'Int', maxBound::'Int']@ range + | IP !BigNat# -- ^ iff value in @]maxBound::'Int', +inf[@ range + | IN !BigNat# -- ^ iff value in @]-inf, minBound::'Int'[@ range -- | Check Integer invariants @@ -79,8 +79,8 @@ integerOne = IS 1# --------------------------------------------------------------------- -- | Create a positive Integer from a BigNat -integerFromBigNat :: BigNat -> Integer -integerFromBigNat !bn +integerFromBigNat# :: BigNat# -> Integer +integerFromBigNat# !bn | bigNatIsZero bn = integerZero @@ -91,8 +91,8 @@ integerFromBigNat !bn = IP bn -- | Create a negative Integer from a BigNat -integerFromBigNatNeg :: BigNat -> Integer -integerFromBigNatNeg !bn +integerFromBigNatNeg# :: BigNat# -> Integer +integerFromBigNatNeg# !bn | bigNatIsZero bn = integerZero @@ -105,22 +105,22 @@ integerFromBigNatNeg !bn = IN bn -- | Create an Integer from a sign-bit and a BigNat -integerFromBigNatSign :: Int# -> BigNat -> Integer -integerFromBigNatSign !sign !bn +integerFromBigNatSign# :: Int# -> BigNat# -> Integer +integerFromBigNatSign# !sign !bn | 0# <- sign - = integerFromBigNat bn + = integerFromBigNat# bn | True - = integerFromBigNatNeg bn + = integerFromBigNatNeg# bn -- | Convert an Integer into a BigNat. -- -- Return 0 for negative Integers. -integerToBigNatClamp :: Integer -> BigNat -integerToBigNatClamp (IP x) = x -integerToBigNatClamp (IS x) +integerToBigNatClamp# :: Integer -> BigNat# +integerToBigNatClamp# (IP x) = x +integerToBigNatClamp# (IS x) | isTrue# (x >=# 0#) = bigNatFromWord# (int2Word# x) -integerToBigNatClamp _ = bigNatZero void# +integerToBigNatClamp# _ = bigNatZero# void# -- | Create an Integer from an Int# integerFromInt# :: Int# -> Integer @@ -185,12 +185,12 @@ integerToWord !i = W# (integerToWord# i) integerFromNatural :: Natural -> Integer {-# NOINLINE integerFromNatural #-} integerFromNatural (NS x) = integerFromWord# x -integerFromNatural (NB x) = integerFromBigNat x +integerFromNatural (NB x) = integerFromBigNat# x -- | Convert a list of Word into an Integer integerFromWordList :: Bool -> [Word] -> Integer -integerFromWordList True ws = integerFromBigNatNeg (bigNatFromWordList ws) -integerFromWordList False ws = integerFromBigNat (bigNatFromWordList ws) +integerFromWordList True ws = integerFromBigNatNeg# (bigNatFromWordList ws) +integerFromWordList False ws = integerFromBigNat# (bigNatFromWordList ws) -- | Convert a Integer into a Natural -- @@ -200,7 +200,7 @@ integerToNaturalClamp :: Integer -> Natural integerToNaturalClamp (IS x) | isTrue# (x <# 0#) = naturalZero | True = naturalFromWord# (int2Word# x) -integerToNaturalClamp (IP x) = naturalFromBigNat x +integerToNaturalClamp (IP x) = naturalFromBigNat# x integerToNaturalClamp (IN _) = naturalZero -- | Convert a Integer into a Natural @@ -209,8 +209,8 @@ integerToNaturalClamp (IN _) = naturalZero integerToNatural :: Integer -> Natural {-# NOINLINE integerToNatural #-} integerToNatural (IS x) = naturalFromWord# (wordFromAbsInt# x) -integerToNatural (IP x) = naturalFromBigNat x -integerToNatural (IN x) = naturalFromBigNat x +integerToNatural (IP x) = naturalFromBigNat# x +integerToNatural (IN x) = naturalFromBigNat# x --------------------------------------------------------------------- -- Predicates @@ -338,36 +338,36 @@ integerSub (IS x#) (IS y#) -> IP (bigNatFromWord# ( (int2Word# z#))) integerSub (IS x#) (IP y) | isTrue# (x# >=# 0#) - = integerFromBigNatNeg (bigNatSubWordUnsafe# y (int2Word# x#)) + = integerFromBigNatNeg# (bigNatSubWordUnsafe# y (int2Word# x#)) | True = IN (bigNatAddWord# y (int2Word# (negateInt# x#))) integerSub (IS x#) (IN y) | isTrue# (x# >=# 0#) = IP (bigNatAddWord# y (int2Word# x#)) | True - = integerFromBigNat (bigNatSubWordUnsafe# y (int2Word# (negateInt# x#))) + = integerFromBigNat# (bigNatSubWordUnsafe# y (int2Word# (negateInt# x#))) integerSub (IP x) (IP y) = case bigNatCompare x y of - LT -> integerFromBigNatNeg (bigNatSubUnsafe y x) + LT -> integerFromBigNatNeg# (bigNatSubUnsafe y x) EQ -> IS 0# - GT -> integerFromBigNat (bigNatSubUnsafe x y) + GT -> integerFromBigNat# (bigNatSubUnsafe x y) integerSub (IP x) (IN y) = IP (bigNatAdd x y) integerSub (IN x) (IP y) = IN (bigNatAdd x y) integerSub (IN x) (IN y) = case bigNatCompare x y of - LT -> integerFromBigNat (bigNatSubUnsafe y x) + LT -> integerFromBigNat# (bigNatSubUnsafe y x) EQ -> IS 0# - GT -> integerFromBigNatNeg (bigNatSubUnsafe x y) + GT -> integerFromBigNatNeg# (bigNatSubUnsafe x y) integerSub (IP x) (IS y#) | isTrue# (y# >=# 0#) - = integerFromBigNat (bigNatSubWordUnsafe# x (int2Word# y#)) + = integerFromBigNat# (bigNatSubWordUnsafe# x (int2Word# y#)) | True = IP (bigNatAddWord# x (int2Word# (negateInt# y#))) integerSub (IN x) (IS y#) | isTrue# (y# >=# 0#) = IN (bigNatAddWord# x (int2Word# y#)) | True - = integerFromBigNatNeg (bigNatSubWordUnsafe# x (int2Word# (negateInt# y#))) + = integerFromBigNatNeg# (bigNatSubWordUnsafe# x (int2Word# (negateInt# y#))) -- | Add two 'Integer's integerAdd :: Integer -> Integer -> Integer @@ -386,17 +386,17 @@ integerAdd (IP x) (IP y) = IP (bigNatAdd x y) integerAdd (IN x) (IN y) = IN (bigNatAdd x y) integerAdd (IP x) (IS y#) -- edge-case: @(maxBound+1) + minBound == 0@ | isTrue# (y# >=# 0#) = IP (bigNatAddWord# x (int2Word# y#)) - | True = integerFromBigNat (bigNatSubWordUnsafe# x (int2Word# + | True = integerFromBigNat# (bigNatSubWordUnsafe# x (int2Word# (negateInt# y#))) integerAdd (IN x) (IS y#) -- edge-case: @(minBound-1) + maxBound == -2@ - | isTrue# (y# >=# 0#) = integerFromBigNatNeg (bigNatSubWordUnsafe# x (int2Word# y#)) + | isTrue# (y# >=# 0#) = integerFromBigNatNeg# (bigNatSubWordUnsafe# x (int2Word# y#)) | True = IN (bigNatAddWord# x (int2Word# (negateInt# y#))) integerAdd y@(IN _) x@(IP _) = integerAdd x y integerAdd (IP x) (IN y) = case bigNatCompare x y of - LT -> integerFromBigNatNeg (bigNatSubUnsafe y x) + LT -> integerFromBigNatNeg# (bigNatSubUnsafe y x) EQ -> IS 0# - GT -> integerFromBigNat (bigNatSubUnsafe x y) + GT -> integerFromBigNat# (bigNatSubUnsafe x y) -- | Multiply two 'Integer's integerMul :: Integer -> Integer -> Integer @@ -569,9 +569,9 @@ integerShiftR# (IS i) n = IS (iShiftRA# i (word2Int# n)) iShiftRA# a b | isTrue# (b >=# WORD_SIZE_IN_BITS#) = (a <# 0#) *# (-1#) | True = a `uncheckedIShiftRA#` b -integerShiftR# (IP bn) n = integerFromBigNat (bigNatShiftR# bn n) +integerShiftR# (IP bn) n = integerFromBigNat# (bigNatShiftR# bn n) integerShiftR# (IN bn) n = - case integerFromBigNatNeg (bigNatShiftRNeg# bn n) of + case integerFromBigNatNeg# (bigNatShiftRNeg# bn n) of IS 0# -> IS -1# r -> r @@ -588,8 +588,8 @@ integerShiftL# !x 0## = x integerShiftL# (IS 0#) _ = IS 0# integerShiftL# (IS 1#) n = integerBit# n integerShiftL# (IS i) n - | isTrue# (i >=# 0#) = integerFromBigNat (bigNatShiftL# (bigNatFromWord# (int2Word# i)) n) - | True = integerFromBigNatNeg (bigNatShiftL# (bigNatFromWord# (int2Word# (negateInt# i))) n) + | isTrue# (i >=# 0#) = integerFromBigNat# (bigNatShiftL# (bigNatFromWord# (int2Word# i)) n) + | True = integerFromBigNatNeg# (bigNatShiftL# (bigNatFromWord# (int2Word# (negateInt# i))) n) integerShiftL# (IP bn) n = IP (bigNatShiftL# bn n) integerShiftL# (IN bn) n = IN (bigNatShiftL# bn n) @@ -613,8 +613,8 @@ integerOr a b = case a of IS -1# -> IS -1# IS y -> IS (orI# x y) IP y - | isTrue# (x >=# 0#) -> integerFromBigNat (bigNatOrWord# y (int2Word# x)) - | True -> integerFromBigNatNeg + | isTrue# (x >=# 0#) -> integerFromBigNat# (bigNatOrWord# y (int2Word# x)) + | True -> integerFromBigNatNeg# (bigNatAddWord# (bigNatAndNot -- use De Morgan's laws (bigNatFromWord# @@ -622,13 +622,13 @@ integerOr a b = case a of y) 1##) IN y - | isTrue# (x >=# 0#) -> integerFromBigNatNeg + | isTrue# (x >=# 0#) -> integerFromBigNatNeg# (bigNatAddWord# (bigNatAndNotWord# -- use De Morgan's laws (bigNatSubWordUnsafe# y 1##) (int2Word# x)) 1##) - | True -> integerFromBigNatNeg + | True -> integerFromBigNatNeg# (bigNatAddWord# (bigNatAndWord# -- use De Morgan's laws (bigNatSubWordUnsafe# y 1##) @@ -636,8 +636,8 @@ integerOr a b = case a of 1##) IP x -> case b of IS _ -> integerOr b a - IP y -> integerFromBigNat (bigNatOr x y) - IN y -> integerFromBigNatNeg + IP y -> integerFromBigNat# (bigNatOr x y) + IN y -> integerFromBigNatNeg# (bigNatAddWord# (bigNatAndNot -- use De Morgan's laws (bigNatSubWordUnsafe# y 1##) @@ -645,13 +645,13 @@ integerOr a b = case a of 1##) IN x -> case b of IS _ -> integerOr b a - IN y -> integerFromBigNatNeg + IN y -> integerFromBigNatNeg# (bigNatAddWord# (bigNatAnd -- use De Morgan's laws (bigNatSubWordUnsafe# x 1##) (bigNatSubWordUnsafe# y 1##)) 1##) - IP y -> integerFromBigNatNeg + IP y -> integerFromBigNatNeg# (bigNatAddWord# (bigNatAndNot -- use De Morgan's laws (bigNatSubWordUnsafe# x 1##) @@ -672,28 +672,28 @@ integerXor a b = case a of IS -1# -> integerComplement a IS y -> IS (xorI# x y) IP y - | isTrue# (x >=# 0#) -> integerFromBigNat (bigNatXorWord# y (int2Word# x)) - | True -> integerFromBigNatNeg + | isTrue# (x >=# 0#) -> integerFromBigNat# (bigNatXorWord# y (int2Word# x)) + | True -> integerFromBigNatNeg# (bigNatAddWord# (bigNatXorWord# y (int2Word# (negateInt# x) `minusWord#` 1##)) 1##) IN y - | isTrue# (x >=# 0#) -> integerFromBigNatNeg + | isTrue# (x >=# 0#) -> integerFromBigNatNeg# (bigNatAddWord# (bigNatXorWord# (bigNatSubWordUnsafe# y 1##) (int2Word# x)) 1##) - | True -> integerFromBigNat + | True -> integerFromBigNat# (bigNatXorWord# -- xor (not x) (not y) = xor x y (bigNatSubWordUnsafe# y 1##) (int2Word# (negateInt# x) `minusWord#` 1##)) IP x -> case b of IS _ -> integerXor b a - IP y -> integerFromBigNat (bigNatXor x y) - IN y -> integerFromBigNatNeg + IP y -> integerFromBigNat# (bigNatXor x y) + IN y -> integerFromBigNatNeg# (bigNatAddWord# (bigNatXor x @@ -701,11 +701,11 @@ integerXor a b = case a of 1##) IN x -> case b of IS _ -> integerXor b a - IN y -> integerFromBigNat + IN y -> integerFromBigNat# (bigNatXor -- xor (not x) (not y) = xor x y (bigNatSubWordUnsafe# x 1##) (bigNatSubWordUnsafe# y 1##)) - IP y -> integerFromBigNatNeg + IP y -> integerFromBigNatNeg# (bigNatAddWord# (bigNatXor y @@ -726,10 +726,10 @@ integerAnd a b = case a of IS 0# -> IS 0# IS -1# -> a IS y -> IS (andI# x y) - IP y -> integerFromBigNat (bigNatAndInt# y x) + IP y -> integerFromBigNat# (bigNatAndInt# y x) IN y | isTrue# (x >=# 0#) -> integerFromWord# (int2Word# x `andNot#` (indexWordArray# y 0# `minusWord#` 1##)) - | True -> integerFromBigNatNeg + | True -> integerFromBigNatNeg# (bigNatAddWord# (bigNatOrWord# -- use De Morgan's laws (bigNatSubWordUnsafe# y 1##) @@ -737,17 +737,17 @@ integerAnd a b = case a of 1##) IP x -> case b of IS _ -> integerAnd b a - IP y -> integerFromBigNat (bigNatAnd x y) - IN y -> integerFromBigNat (bigNatAndNot x (bigNatSubWordUnsafe# y 1##)) + IP y -> integerFromBigNat# (bigNatAnd x y) + IN y -> integerFromBigNat# (bigNatAndNot x (bigNatSubWordUnsafe# y 1##)) IN x -> case b of IS _ -> integerAnd b a - IN y -> integerFromBigNatNeg + IN y -> integerFromBigNatNeg# (bigNatAddWord# (bigNatOr -- use De Morgan's laws (bigNatSubWordUnsafe# x 1##) (bigNatSubWordUnsafe# y 1##)) 1##) - IP y -> integerFromBigNat (bigNatAndNot y (bigNatSubWordUnsafe# x 1##)) + IP y -> integerFromBigNat# (bigNatAndNot y (bigNatSubWordUnsafe# x 1##)) @@ -774,23 +774,23 @@ integerQuotRem# (IS 0#) _ = (# IS 0#, IS 0# #) integerQuotRem# (IS n#) (IS d#) = case quotRemInt# n# d# of (# q#, r# #) -> (# IS q#, IS r# #) integerQuotRem# (IP n) (IP d) = case bigNatQuotRem# n d of - (# q, r #) -> (# integerFromBigNat q, integerFromBigNat r #) + (# q, r #) -> (# integerFromBigNat# q, integerFromBigNat# r #) integerQuotRem# (IP n) (IN d) = case bigNatQuotRem# n d of - (# q, r #) -> (# integerFromBigNatNeg q, integerFromBigNat r #) + (# q, r #) -> (# integerFromBigNatNeg# q, integerFromBigNat# r #) integerQuotRem# (IN n) (IN d) = case bigNatQuotRem# n d of - (# q, r #) -> (# integerFromBigNat q, integerFromBigNatNeg r #) + (# q, r #) -> (# integerFromBigNat# q, integerFromBigNatNeg# r #) integerQuotRem# (IN n) (IP d) = case bigNatQuotRem# n d of - (# q, r #) -> (# integerFromBigNatNeg q, integerFromBigNatNeg r #) + (# q, r #) -> (# integerFromBigNatNeg# q, integerFromBigNatNeg# r #) integerQuotRem# (IP n) (IS d#) | isTrue# (d# >=# 0#) = case bigNatQuotRemWord# n (int2Word# d#) of - (# q, r# #) -> (# integerFromBigNat q, integerFromWord# r# #) + (# q, r# #) -> (# integerFromBigNat# q, integerFromWord# r# #) | True = case bigNatQuotRemWord# n (int2Word# (negateInt# d#)) of - (# q, r# #) -> (# integerFromBigNatNeg q, integerFromWord# r# #) + (# q, r# #) -> (# integerFromBigNatNeg# q, integerFromWord# r# #) integerQuotRem# (IN n) (IS d#) | isTrue# (d# >=# 0#) = case bigNatQuotRemWord# n (int2Word# d#) of - (# q, r# #) -> (# integerFromBigNatNeg q, integerFromWordNeg# r# #) + (# q, r# #) -> (# integerFromBigNatNeg# q, integerFromWordNeg# r# #) | True = case bigNatQuotRemWord# n (int2Word# (negateInt# d#)) of - (# q, r# #) -> (# integerFromBigNat q, integerFromWordNeg# r# #) + (# q, r# #) -> (# integerFromBigNat# q, integerFromWordNeg# r# #) integerQuotRem# n@(IS _) (IN _) = (# IS 0#, n #) -- since @n < d@ integerQuotRem# n@(IS n#) (IP d) -- need to account for (IS minBound) | isTrue# (n# ># 0#) = (# IS 0#, n #) @@ -814,17 +814,17 @@ integerQuot !_ (IS 0#) = raiseDivZero integerQuot (IS 0#) _ = IS 0# integerQuot (IS n#) (IS d#) = IS (quotInt# n# d#) integerQuot (IP n) (IS d#) - | isTrue# (d# >=# 0#) = integerFromBigNat (bigNatQuotWord# n (int2Word# d#)) - | True = integerFromBigNatNeg (bigNatQuotWord# n + | isTrue# (d# >=# 0#) = integerFromBigNat# (bigNatQuotWord# n (int2Word# d#)) + | True = integerFromBigNatNeg# (bigNatQuotWord# n (int2Word# (negateInt# d#))) integerQuot (IN n) (IS d#) - | isTrue# (d# >=# 0#) = integerFromBigNatNeg (bigNatQuotWord# n (int2Word# d#)) - | True = integerFromBigNat (bigNatQuotWord# n + | isTrue# (d# >=# 0#) = integerFromBigNatNeg# (bigNatQuotWord# n (int2Word# d#)) + | True = integerFromBigNat# (bigNatQuotWord# n (int2Word# (negateInt# d#))) -integerQuot (IP n) (IP d) = integerFromBigNat (bigNatQuot n d) -integerQuot (IP n) (IN d) = integerFromBigNatNeg (bigNatQuot n d) -integerQuot (IN n) (IP d) = integerFromBigNatNeg (bigNatQuot n d) -integerQuot (IN n) (IN d) = integerFromBigNat (bigNatQuot n d) +integerQuot (IP n) (IP d) = integerFromBigNat# (bigNatQuot n d) +integerQuot (IP n) (IN d) = integerFromBigNatNeg# (bigNatQuot n d) +integerQuot (IN n) (IP d) = integerFromBigNatNeg# (bigNatQuot n d) +integerQuot (IN n) (IN d) = integerFromBigNat# (bigNatQuot n d) integerQuot n d = case integerQuotRem# n d of (# q, _ #) -> q integerRem :: Integer -> Integer -> Integer @@ -838,10 +838,10 @@ integerRem (IP n) (IS d#) = integerFromWord# (bigNatRemWord# n (int2Word# (absI# d#))) integerRem (IN n) (IS d#) = integerFromWordNeg# (bigNatRemWord# n (int2Word# (absI# d#))) -integerRem (IP n) (IP d) = integerFromBigNat (bigNatRem n d) -integerRem (IP n) (IN d) = integerFromBigNat (bigNatRem n d) -integerRem (IN n) (IP d) = integerFromBigNatNeg (bigNatRem n d) -integerRem (IN n) (IN d) = integerFromBigNatNeg (bigNatRem n d) +integerRem (IP n) (IP d) = integerFromBigNat# (bigNatRem n d) +integerRem (IP n) (IN d) = integerFromBigNat# (bigNatRem n d) +integerRem (IN n) (IP d) = integerFromBigNatNeg# (bigNatRem n d) +integerRem (IN n) (IN d) = integerFromBigNatNeg# (bigNatRem n d) integerRem n d = case integerQuotRem# n d of (# _, r #) -> r @@ -898,8 +898,8 @@ integerGcd (IS a) (IS b) = integerFromWord# (gcdWord# (int2Word# (absI# b))) integerGcd a@(IS _) b = integerGcd b a integerGcd (IN a) b = integerGcd (IP a) b -integerGcd (IP a) (IP b) = integerFromBigNat (bigNatGcd a b) -integerGcd (IP a) (IN b) = integerFromBigNat (bigNatGcd a b) +integerGcd (IP a) (IP b) = integerFromBigNat# (bigNatGcd a b) +integerGcd (IP a) (IN b) = integerFromBigNat# (bigNatGcd a b) integerGcd (IP a) (IS b) = integerFromWord# (bigNatGcdWord# a (int2Word# (absI# b))) -- | Compute least common multiple. @@ -1107,7 +1107,7 @@ integerToAddr a addr e = IO \s -> case integerToAddr# a addr e s of integerFromAddr# :: Word# -> Addr# -> Bool# -> State# s -> (# State# s, Integer #) integerFromAddr# sz addr e s = case bigNatFromAddr# sz addr e s of - (# s', n #) -> (# s', integerFromBigNat n #) + (# s', n #) -> (# s', integerFromBigNat# n #) -- | Read an 'Integer' (without sign) in base-256 representation from an Addr#. -- @@ -1155,7 +1155,7 @@ integerToMutableByteArray i mba w e = IO \s -> case integerToMutableByteArray# i -- Null higher limbs are automatically trimed. integerFromByteArray# :: Word# -> ByteArray# -> Word# -> Bool# -> State# s -> (# State# s, Integer #) integerFromByteArray# sz ba off e s = case bigNatFromByteArray# sz ba off e s of - (# s', a #) -> (# s', integerFromBigNat a #) + (# s', a #) -> (# s', integerFromBigNat# a #) -- | Read an 'Integer' (without sign) in base-256 representation from a ByteArray#. -- diff --git a/libraries/ghc-bignum/src/GHC/Num/Natural.hs b/libraries/ghc-bignum/src/GHC/Num/Natural.hs index 574f8f04b3..ac35b65522 100644 --- a/libraries/ghc-bignum/src/GHC/Num/Natural.hs +++ b/libraries/ghc-bignum/src/GHC/Num/Natural.hs @@ -24,7 +24,7 @@ default () -- Invariant: numbers <= WORD_MAXBOUND use the `NS` constructor data Natural = NS !Word# - | NB !BigNat + | NB !BigNat# instance Eq Natural where (==) = naturalEq @@ -66,17 +66,17 @@ naturalIsPowerOf2# :: Natural -> (# () | Word# #) naturalIsPowerOf2# (NS w) = wordIsPowerOf2# w naturalIsPowerOf2# (NB w) = bigNatIsPowerOf2# w --- | Create a Natural from a BigNat (respect the invariants) -naturalFromBigNat :: BigNat -> Natural -naturalFromBigNat x = case bigNatSize# x of +-- | Create a Natural from a BigNat# (respect the invariants) +naturalFromBigNat# :: BigNat# -> Natural +naturalFromBigNat# x = case bigNatSize# x of 0# -> naturalZero 1# -> NS (bigNatIndex# x 0#) _ -> NB x --- | Convert a Natural into a BigNat -naturalToBigNat :: Natural -> BigNat -naturalToBigNat (NS w) = bigNatFromWord# w -naturalToBigNat (NB bn) = bn +-- | Convert a Natural into a BigNat# +naturalToBigNat# :: Natural -> BigNat# +naturalToBigNat# (NS w) = bigNatFromWord# w +naturalToBigNat# (NB bn) = bn -- | Create a Natural from a Word# naturalFromWord# :: Word# -> Natural @@ -95,7 +95,7 @@ naturalFromWord (W# x) = NS x -- | Create a Natural from a list of Word naturalFromWordList :: [Word] -> Natural -naturalFromWordList xs = naturalFromBigNat (bigNatFromWordList xs) +naturalFromWordList xs = naturalFromBigNat# (bigNatFromWordList xs) -- | Convert the lower bits of a Natural into a Word# naturalToWord# :: Natural -> Word# @@ -223,7 +223,7 @@ naturalPopCount (NB x) = bigNatPopCount x -- | Right shift for Natural naturalShiftR# :: Natural -> Word# -> Natural naturalShiftR# (NS x) n = NS (x `shiftRW#` n) -naturalShiftR# (NB x) n = naturalFromBigNat (x `bigNatShiftR#` n) +naturalShiftR# (NB x) n = naturalFromBigNat# (x `bigNatShiftR#` n) -- | Right shift for Natural naturalShiftR :: Natural -> Word -> Natural @@ -255,7 +255,7 @@ naturalAdd (NS x) (NS y) = naturalSub :: Natural -> Natural -> (# () | Natural #) {-# NOINLINE naturalSub #-} naturalSub (NS _) (NB _) = (# () | #) -naturalSub (NB x) (NS y) = (# | naturalFromBigNat (bigNatSubWordUnsafe# x y) #) +naturalSub (NB x) (NS y) = (# | naturalFromBigNat# (bigNatSubWordUnsafe# x y) #) naturalSub (NS x) (NS y) = case subWordC# x y of (# l,0# #) -> (# | NS l #) @@ -263,14 +263,14 @@ naturalSub (NS x) (NS y) = naturalSub (NB x) (NB y) = case bigNatSub x y of (# () | #) -> (# () | #) - (# | z #) -> (# | naturalFromBigNat z #) + (# | z #) -> (# | naturalFromBigNat# z #) -- | Sub two naturals -- -- Throw an Underflow exception if x < y naturalSubThrow :: Natural -> Natural -> Natural naturalSubThrow (NS _) (NB _) = raiseUnderflow -naturalSubThrow (NB x) (NS y) = naturalFromBigNat (bigNatSubWordUnsafe# x y) +naturalSubThrow (NB x) (NS y) = naturalFromBigNat# (bigNatSubWordUnsafe# x y) naturalSubThrow (NS x) (NS y) = case subWordC# x y of (# l,0# #) -> NS l @@ -278,7 +278,7 @@ naturalSubThrow (NS x) (NS y) = naturalSubThrow (NB x) (NB y) = case bigNatSub x y of (# () | #) -> raiseUnderflow - (# | z #) -> naturalFromBigNat z + (# | z #) -> naturalFromBigNat# z -- | Sub two naturals -- @@ -288,11 +288,11 @@ naturalSubUnsafe :: Natural -> Natural -> Natural {-# NOINLINE naturalSubUnsafe #-} naturalSubUnsafe (NS x) (NS y) = NS (minusWord# x y) naturalSubUnsafe (NS _) (NB _) = naturalZero -naturalSubUnsafe (NB x) (NS y) = naturalFromBigNat (bigNatSubWordUnsafe# x y) +naturalSubUnsafe (NB x) (NS y) = naturalFromBigNat# (bigNatSubWordUnsafe# x y) naturalSubUnsafe (NB x) (NB y) = case bigNatSub x y of (# () | #) -> naturalZero - (# | z #) -> naturalFromBigNat z + (# | z #) -> naturalFromBigNat# z -- | Multiplication naturalMul :: Natural -> Natural -> Natural @@ -335,11 +335,11 @@ naturalQuotRem# :: Natural -> Natural -> (# Natural, Natural #) naturalQuotRem# (NS n) (NS d) = case quotRemWord# n d of (# q, r #) -> (# NS q, NS r #) naturalQuotRem# (NB n) (NS d) = case bigNatQuotRemWord# n d of - (# q, r #) -> (# naturalFromBigNat q, NS r #) + (# q, r #) -> (# naturalFromBigNat# q, NS r #) naturalQuotRem# (NS n) (NB d) = case bigNatQuotRem# (bigNatFromWord# n) d of - (# q, r #) -> (# naturalFromBigNat q, naturalFromBigNat r #) + (# q, r #) -> (# naturalFromBigNat# q, naturalFromBigNat# r #) naturalQuotRem# (NB n) (NB d) = case bigNatQuotRem# n d of - (# q, r #) -> (# naturalFromBigNat q, naturalFromBigNat r #) + (# q, r #) -> (# naturalFromBigNat# q, naturalFromBigNat# r #) -- | Return division quotient and remainder naturalQuotRem :: Natural -> Natural -> (Natural, Natural) @@ -352,11 +352,11 @@ naturalQuot :: Natural -> Natural -> Natural naturalQuot (NS n) (NS d) = case quotWord# n d of q -> NS q naturalQuot (NB n) (NS d) = case bigNatQuotWord# n d of - q -> naturalFromBigNat q + q -> naturalFromBigNat# q naturalQuot (NS n) (NB d) = case bigNatQuot (bigNatFromWord# n) d of - q -> naturalFromBigNat q + q -> naturalFromBigNat# q naturalQuot (NB n) (NB d) = case bigNatQuot n d of - q -> naturalFromBigNat q + q -> naturalFromBigNat# q -- | Return division remainder naturalRem :: Natural -> Natural -> Natural @@ -366,21 +366,21 @@ naturalRem (NS n) (NS d) = case remWord# n d of naturalRem (NB n) (NS d) = case bigNatRemWord# n d of r -> NS r naturalRem (NS n) (NB d) = case bigNatRem (bigNatFromWord# n) d of - r -> naturalFromBigNat r + r -> naturalFromBigNat# r naturalRem (NB n) (NB d) = case bigNatRem n d of - r -> naturalFromBigNat r + r -> naturalFromBigNat# r naturalAnd :: Natural -> Natural -> Natural naturalAnd (NS n) (NS m) = NS (n `and#` m) naturalAnd (NS n) (NB m) = NS (n `and#` bigNatToWord# m) naturalAnd (NB n) (NS m) = NS (bigNatToWord# n `and#` m) -naturalAnd (NB n) (NB m) = naturalFromBigNat (bigNatAnd n m) +naturalAnd (NB n) (NB m) = naturalFromBigNat# (bigNatAnd n m) naturalAndNot :: Natural -> Natural -> Natural naturalAndNot (NS n) (NS m) = NS (n `and#` not# m) naturalAndNot (NS n) (NB m) = NS (n `and#` not# (bigNatToWord# m)) naturalAndNot (NB n) (NS m) = NS (bigNatToWord# n `and#` not# m) -naturalAndNot (NB n) (NB m) = naturalFromBigNat (bigNatAndNot n m) +naturalAndNot (NB n) (NB m) = naturalFromBigNat# (bigNatAndNot n m) naturalOr :: Natural -> Natural -> Natural naturalOr (NS n) (NS m) = NS (n `or#` m) @@ -392,7 +392,7 @@ naturalXor :: Natural -> Natural -> Natural naturalXor (NS n) (NS m) = NS (n `xor#` m) naturalXor (NS n) (NB m) = NB (bigNatXorWord# m n) naturalXor (NB n) (NS m) = NB (bigNatXorWord# n m) -naturalXor (NB n) (NB m) = naturalFromBigNat (bigNatXor n m) +naturalXor (NB n) (NB m) = naturalFromBigNat# (bigNatXor n m) naturalTestBit# :: Natural -> Word# -> Bool# naturalTestBit# (NS w) i = (i `ltWord#` WORD_SIZE_IN_BITS##) &&# @@ -416,7 +416,7 @@ naturalGcd (NS 0##) !y = y naturalGcd x (NS 0##) = x naturalGcd (NS 1##) _ = NS 1## naturalGcd _ (NS 1##) = NS 1## -naturalGcd (NB x) (NB y) = naturalFromBigNat (bigNatGcd x y) +naturalGcd (NB x) (NB y) = naturalFromBigNat# (bigNatGcd x y) naturalGcd (NB x) (NS y) = NS (bigNatGcdWord# x y) naturalGcd (NS x) (NB y) = NS (bigNatGcdWord# y x) naturalGcd (NS x) (NS y) = NS (gcdWord# x y) @@ -427,10 +427,10 @@ naturalLcm (NS 0##) !_ = NS 0## naturalLcm _ (NS 0##) = NS 0## naturalLcm (NS 1##) y = y naturalLcm x (NS 1##) = x -naturalLcm (NS a ) (NS b ) = naturalFromBigNat (bigNatLcmWordWord# a b) -naturalLcm (NB a ) (NS b ) = naturalFromBigNat (bigNatLcmWord# a b) -naturalLcm (NS a ) (NB b ) = naturalFromBigNat (bigNatLcmWord# b a) -naturalLcm (NB a ) (NB b ) = naturalFromBigNat (bigNatLcm a b) +naturalLcm (NS a ) (NS b ) = naturalFromBigNat# (bigNatLcmWordWord# a b) +naturalLcm (NB a ) (NS b ) = naturalFromBigNat# (bigNatLcmWord# a b) +naturalLcm (NS a ) (NB b ) = naturalFromBigNat# (bigNatLcmWord# b a) +naturalLcm (NB a ) (NB b ) = naturalFromBigNat# (bigNatLcm a b) -- | Base 2 logarithm naturalLog2# :: Natural -> Word# @@ -470,12 +470,12 @@ naturalPowMod (NS 0##) _ _ = NS 0## naturalPowMod (NS 1##) _ _ = NS 1## naturalPowMod (NS b) (NS e) (NS m) = NS (powModWord# b e m) naturalPowMod b e (NS m) = NS (bigNatPowModWord# - (naturalToBigNat b) - (naturalToBigNat e) + (naturalToBigNat# b) + (naturalToBigNat# e) m) -naturalPowMod b e (NB m) = naturalFromBigNat - (bigNatPowMod (naturalToBigNat b) - (naturalToBigNat e) +naturalPowMod b e (NB m) = naturalFromBigNat# + (bigNatPowMod (naturalToBigNat# b) + (naturalToBigNat# e) m) -- | Compute the number of digits of the Natural in the given base. @@ -518,7 +518,7 @@ naturalToAddr a addr e = IO \s -> case naturalToAddr# a addr e s of naturalFromAddr# :: Word# -> Addr# -> Bool# -> State# s -> (# State# s, Natural #) naturalFromAddr# sz addr e s = case bigNatFromAddr# sz addr e s of - (# s', n #) -> (# s', naturalFromBigNat n #) + (# s', n #) -> (# s', naturalFromBigNat# n #) -- | Read a Natural in base-256 representation from an Addr#. -- @@ -554,4 +554,4 @@ naturalToMutableByteArray# (NB a) = bigNatToMutableByteArray# a -- Null higher limbs are automatically trimed. naturalFromByteArray# :: Word# -> ByteArray# -> Word# -> Bool# -> State# s -> (# State# s, Natural #) naturalFromByteArray# sz ba off e s = case bigNatFromByteArray# sz ba off e s of - (# s', a #) -> (# s', naturalFromBigNat a #) + (# s', a #) -> (# s', naturalFromBigNat# a #) -- cgit v1.2.1