diff options
Diffstat (limited to 'libraries/base/GHC')
| -rw-r--r-- | libraries/base/GHC/Base.hs | 43 | ||||
| -rw-r--r-- | libraries/base/GHC/Enum.hs | 30 | ||||
| -rw-r--r-- | libraries/base/GHC/Err.hs | 6 | ||||
| -rw-r--r-- | libraries/base/GHC/Float.hs | 118 | ||||
| -rw-r--r-- | libraries/base/GHC/Float/ConversionUtils.hs | 14 | ||||
| -rw-r--r-- | libraries/base/GHC/Float/RealFracMethods.hs | 50 | ||||
| -rw-r--r-- | libraries/base/GHC/Generics.hs | 4 | ||||
| -rw-r--r-- | libraries/base/GHC/IO.hs-boot | 2 | ||||
| -rw-r--r-- | libraries/base/GHC/Int.hs | 28 | ||||
| -rw-r--r-- | libraries/base/GHC/Integer.hs | 219 | ||||
| -rw-r--r-- | libraries/base/GHC/Integer/Logarithms.hs | 24 | ||||
| -rw-r--r-- | libraries/base/GHC/List.hs | 2 | ||||
| -rw-r--r-- | libraries/base/GHC/Maybe.hs | 2 | ||||
| -rw-r--r-- | libraries/base/GHC/Natural.hs | 682 | ||||
| -rw-r--r-- | libraries/base/GHC/Num.hs | 65 | ||||
| -rw-r--r-- | libraries/base/GHC/Ptr.hs | 2 | ||||
| -rw-r--r-- | libraries/base/GHC/Real.hs | 97 | ||||
| -rw-r--r-- | libraries/base/GHC/Show.hs | 15 | ||||
| -rw-r--r-- | libraries/base/GHC/Stack/Types.hs | 5 | ||||
| -rw-r--r-- | libraries/base/GHC/TypeNats.hs | 2 | ||||
| -rw-r--r-- | libraries/base/GHC/Word.hs | 34 |
21 files changed, 653 insertions, 791 deletions
diff --git a/libraries/base/GHC/Base.hs b/libraries/base/GHC/Base.hs index b496bac35e..e344f842df 100644 --- a/libraries/base/GHC/Base.hs +++ b/libraries/base/GHC/Base.hs @@ -121,8 +121,7 @@ import GHC.Maybe import {-# SOURCE #-} GHC.IO (mkUserError, mplusIO) import GHC.Tuple () -- Note [Depend on GHC.Tuple] -import GHC.Integer () -- Note [Depend on GHC.Integer] -import GHC.Natural () -- Note [Depend on GHC.Natural] +import GHC.Num.Integer () -- Note [Depend on GHC.Num.Integer] -- for 'class Semigroup' import {-# SOURCE #-} GHC.Real (Integral) @@ -144,30 +143,33 @@ infixl 4 <*>, <*, *>, <**> default () -- Double isn't available yet {- -Note [Depend on GHC.Integer] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The Integer type is special because GHC.Iface.Tidy uses -GHC.Integer.Type.mkInteger to construct Integer literal values -Currently it reads the interface file whether or not the current -module *has* any Integer literals, so it's important that -GHC.Integer.Type (in package integer-gmp or integer-simple) is -compiled before any other module. (There's a hack in GHC to disable -this for packages ghc-prim, integer-gmp, integer-simple, which aren't -allowed to contain any Integer literals.) - -Likewise we implicitly need Integer when deriving things like Eq -instances. +Note [Depend on GHC.Num.Integer] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +The Integer type is special because GHC.Iface.Tidy uses constructors in +GHC.Num.Integer to construct Integer literal values. Currently it reads the +interface file whether or not the current module *has* any Integer literals, so +it's important that GHC.Num.Integer is compiled before any other module. + +(There's a hack in GHC to disable this for packages ghc-prim and ghc-bignum +which aren't allowed to contain any Integer literals.) + +Likewise we implicitly need Integer when deriving things like Eq instances. The danger is that if the build system doesn't know about the dependency -on Integer, it'll compile some base module before GHC.Integer.Type, +on Integer, it'll compile some base module before GHC.Num.Integer, resulting in: - Failed to load interface for ‘GHC.Integer.Type’ - There are files missing in the ‘integer-gmp’ package, + Failed to load interface for ‘GHC.Num.Integer’ + There are files missing in the ‘ghc-bignum’ package, -Bottom line: we make GHC.Base depend on GHC.Integer; and everything +Bottom line: we make GHC.Base depend on GHC.Num.Integer; and everything else either depends on GHC.Base, or does not have NoImplicitPrelude (and hence depends on Prelude). +Note: this is only a problem with the make-based build system. Hadrian doesn't +seem to interleave compilation of modules from separate packages and respects +the dependency between `base` and `ghc-bignum`. + Note [Depend on GHC.Tuple] ~~~~~~~~~~~~~~~~~~~~~~~~~~ Similarly, tuple syntax (or ()) creates an implicit dependency on @@ -175,9 +177,6 @@ GHC.Tuple, so we use the same rule as for Integer --- see Note [Depend on GHC.Integer] --- to explain this to the build system. We make GHC.Base depend on GHC.Tuple, and everything else depends on GHC.Base or Prelude. -Note [Depend on GHC.Natural] -~~~~~~~~~~~~~~~~~~~~~~~~~~ -Similar to GHC.Integer. -} #if 0 diff --git a/libraries/base/GHC/Enum.hs b/libraries/base/GHC/Enum.hs index 70a964f6d3..54d6c6b34a 100644 --- a/libraries/base/GHC/Enum.hs +++ b/libraries/base/GHC/Enum.hs @@ -33,7 +33,7 @@ module GHC.Enum( import GHC.Base hiding ( many ) import GHC.Char -import GHC.Integer +import GHC.Num.Integer import GHC.Num import GHC.Show default () -- Double isn't available yet @@ -842,8 +842,8 @@ efdtWordDnFB c n x1 x2 y -- Be careful about underflow! instance Enum Integer where succ x = x + 1 pred x = x - 1 - toEnum (I# n) = smallInteger n - fromEnum n = I# (integerToInt n) + toEnum (I# n) = IS n + fromEnum n = integerToInt n -- See Note [Stable Unfolding for list producers] {-# INLINE enumFrom #-} @@ -961,29 +961,25 @@ dn_list x0 delta lim = go (x0 :: Integer) -- | @since 4.8.0.0 instance Enum Natural where - succ n = n `plusNatural` wordToNaturalBase 1## - pred n = n `minusNatural` wordToNaturalBase 1## + succ n = n + 1 + pred n = n - 1 + toEnum i + | i >= 0 = naturalFromIntUnsafe i + | otherwise = errorWithoutStackTrace "toEnum: unexpected negative Int" - toEnum = intToNatural - -#if defined(MIN_VERSION_integer_gmp) - -- This is the integer-gmp special case. The general case is after the endif. - fromEnum (NatS# w) + fromEnum (NS w) | i >= 0 = i | otherwise = errorWithoutStackTrace "fromEnum: out of Int range" where i = I# (word2Int# w) -#endif - fromEnum n = fromEnum (naturalToInteger n) - - enumFrom x = enumDeltaNatural x (wordToNaturalBase 1##) + fromEnum n = fromEnum (integerFromNatural n) + enumFrom x = enumDeltaNatural x 1 enumFromThen x y | x <= y = enumDeltaNatural x (y-x) - | otherwise = enumNegDeltaToNatural x (x-y) (wordToNaturalBase 0##) - - enumFromTo x lim = enumDeltaToNatural x (wordToNaturalBase 1##) lim + | otherwise = enumNegDeltaToNatural x (x-y) 0 + enumFromTo x lim = enumDeltaToNatural x 1 lim enumFromThenTo x y lim | x <= y = enumDeltaToNatural x (y-x) lim | otherwise = enumNegDeltaToNatural x (x-y) lim diff --git a/libraries/base/GHC/Err.hs b/libraries/base/GHC/Err.hs index 17b5b8ec41..f175891eca 100644 --- a/libraries/base/GHC/Err.hs +++ b/libraries/base/GHC/Err.hs @@ -26,11 +26,7 @@ module GHC.Err( absentErr, error, errorWithoutStackTrace, undefined ) where import GHC.Types (Char, RuntimeRep) import GHC.Stack.Types import GHC.Prim -import GHC.Integer () -- Make sure Integer and Natural are compiled first -import GHC.Natural () -- because GHC depends on it in a wired-in way - -- so the build system doesn't see the dependency. - -- See Note [Depend on GHC.Integer] and - -- Note [Depend on GHC.Natural] in GHC.Base. +import GHC.Num.Integer () -- See Note [Depend on GHC.Num.Integer] in GHC.Base import {-# SOURCE #-} GHC.Exception ( errorCallWithCallStackException , errorCallException ) diff --git a/libraries/base/GHC/Float.hs b/libraries/base/GHC/Float.hs index 2f21daa57f..67cc11f9a9 100644 --- a/libraries/base/GHC/Float.hs +++ b/libraries/base/GHC/Float.hs @@ -32,6 +32,17 @@ #include "ieee-flpt.h" #include "MachDeps.h" +#if WORD_SIZE_IN_BITS == 32 +# define WSHIFT 5 +# define MMASK 31 +#elif WORD_SIZE_IN_BITS == 64 +# define WSHIFT 6 +# define MMASK 63 +#else +# error unsupported WORD_SIZE_IN_BITS +#endif + + module GHC.Float ( module GHC.Float , Float(..), Double(..), Float#, Double# @@ -55,8 +66,7 @@ import GHC.Word import GHC.Arr import GHC.Float.RealFracMethods import GHC.Float.ConversionUtils -import GHC.Integer.Logarithms ( integerLogBase# ) -import GHC.Integer.Logarithms.Internals +import GHC.Num.BigNat infixr 8 ** @@ -284,7 +294,7 @@ instance Num Float where | otherwise = x -- handles 0.0, (-0.0), and NaN {-# INLINE fromInteger #-} - fromInteger i = F# (floatFromInteger i) + fromInteger i = F# (integerToFloat# i) -- | @since 2.01 instance Real Float where @@ -292,12 +302,12 @@ instance Real Float where case decodeFloat_Int# x# of (# m#, e# #) | isTrue# (e# >=# 0#) -> - (smallInteger m# `shiftLInteger` e#) :% 1 + (IS m# `integerShiftL#` int2Word# e#) :% 1 | isTrue# ((int2Word# m# `and#` 1##) `eqWord#` 0##) -> case elimZerosInt# m# (negateInt# e#) of - (# n, d# #) -> n :% shiftLInteger 1 d# + (# n, d# #) -> n :% integerShiftL# 1 (int2Word# d#) | otherwise -> - smallInteger m# :% shiftLInteger 1 (negateInt# e#) + IS m# :% integerShiftL# 1 (int2Word# (negateInt# e#)) -- | @since 2.01 -- Note that due to the presence of @NaN@, not all elements of 'Float' have an @@ -422,9 +432,9 @@ instance RealFloat Float where floatRange _ = (FLT_MIN_EXP, FLT_MAX_EXP) -- ditto decodeFloat (F# f#) = case decodeFloat_Int# f# of - (# i, e #) -> (smallInteger i, I# e) + (# i, e #) -> (IS i, I# e) - encodeFloat i (I# e) = F# (encodeFloatInteger i e) + encodeFloat i (I# e) = F# (integerEncodeFloat# i e) exponent x = case decodeFloat x of (m,n) -> if m == 0 then 0 else n + floatDigits x @@ -479,21 +489,21 @@ instance Num Double where {-# INLINE fromInteger #-} - fromInteger i = D# (doubleFromInteger i) + fromInteger i = D# (integerToDouble# i) -- | @since 2.01 instance Real Double where toRational (D# x#) = - case decodeDoubleInteger x# of + case integerDecodeDouble# x# of (# m, e# #) | isTrue# (e# >=# 0#) -> - shiftLInteger m e# :% 1 - | isTrue# ((integerToWord m `and#` 1##) `eqWord#` 0##) -> + integerShiftL# m (int2Word# e#) :% 1 + | isTrue# ((integerToWord# m `and#` 1##) `eqWord#` 0##) -> case elimZerosInteger m (negateInt# e#) of - (# n, d# #) -> n :% shiftLInteger 1 d# + (# n, d# #) -> n :% integerShiftL# 1 (int2Word# d#) | otherwise -> - m :% shiftLInteger 1 (negateInt# e#) + m :% integerShiftL# 1 (int2Word# (negateInt# e#)) -- | @since 2.01 -- Note that due to the presence of @NaN@, not all elements of 'Double' have an @@ -611,10 +621,10 @@ instance RealFloat Double where floatRange _ = (DBL_MIN_EXP, DBL_MAX_EXP) -- ditto decodeFloat (D# x#) - = case decodeDoubleInteger x# of + = case integerDecodeDouble# x# of (# i, j #) -> (i, I# j) - encodeFloat i (I# j) = D# (encodeDoubleInteger i j) + encodeFloat i (I# j) = D# (integerEncodeDouble# i j) exponent x = case decodeFloat x of (m,n) -> if m == 0 then 0 else n + floatDigits x @@ -995,7 +1005,9 @@ fromRat' x = r (minExp0, _) = floatRange r minExp = minExp0 - p -- the real minimum exponent xMax = toRational (expt b p) - p0 = (integerLogBase b (numerator x) - integerLogBase b (denominator x) - p) `max` minExp + ln = I# (word2Int# (integerLogBase# b (numerator x))) + ld = I# (word2Int# (integerLogBase# b (denominator x))) + p0 = (ln - ld - p) `max` minExp -- if x = n/d and ln = integerLogBase b n, ld = integerLogBase b d, -- then b^(ln-ld-1) < x < b^(ln-ld+1) f = if p0 < 0 then 1 :% expt b (-p0) else expt b p0 :% 1 @@ -1029,18 +1041,6 @@ maxExpt10 = 324 expts10 :: Array Int Integer expts10 = array (minExpt,maxExpt10) [(n,10^n) | n <- [minExpt .. maxExpt10]] --- Compute the (floor of the) log of i in base b. --- Simplest way would be just divide i by b until it's smaller then b, but that would --- be very slow! We are just slightly more clever, except for base 2, where --- we take advantage of the representation of Integers. --- The general case could be improved by a lookup table for --- approximating the result by integerLog2 i / integerLog2 b. -integerLogBase :: Integer -> Integer -> Int -integerLogBase b i - | i < b = 0 - | b == 2 = I# (integerLog2# i) - | otherwise = I# (integerLogBase# b i) - {- Unfortunately, the old conversion code was awfully slow due to a) a slow integer logarithm @@ -1061,10 +1061,10 @@ divisions as much as possible. fromRat'' :: RealFloat a => Int -> Int -> Integer -> Integer -> a -- Invariant: n and d strictly positive fromRat'' minEx@(I# me#) mantDigs@(I# md#) n d = - case integerLog2IsPowerOf2# d of - (# ld#, pw# #) - | isTrue# (pw# ==# 0#) -> - case integerLog2# n of + case integerIsPowerOf2# d of + (# | ldw# #) -> + let ld# = word2Int# ldw# + in case word2Int# (integerLog2# n) of ln# | isTrue# (ln# >=# (ld# +# me# -# 1#)) -> -- this means n/d >= 2^(minEx-1), i.e. we are guaranteed to get -- a normalised number, round to mantDigs bits @@ -1095,12 +1095,12 @@ fromRat'' minEx@(I# me#) mantDigs@(I# md#) n d = _ -> encodeFloat (n' + 1) (minEx-mantDigs) | isTrue# (ld'# ># (ln# +# 1#)) -> encodeFloat 0 0 -- result of shift < 0.5 | otherwise -> -- first bit of n shifted to 0.5 place - case integerLog2IsPowerOf2# n of - (# _, 0# #) -> encodeFloat 0 0 -- round to even - (# _, _ #) -> encodeFloat 1 (minEx - mantDigs) - | otherwise -> - let ln = I# (integerLog2# n) - ld = I# ld# + case integerIsPowerOf2# n of + (# | _ #) -> encodeFloat 0 0 -- round to even + (# () | #) -> encodeFloat 1 (minEx - mantDigs) + (# () | #) -> + let ln = I# (word2Int# (integerLog2# n)) + ld = I# (word2Int# (integerLog2# d)) -- 2^(ln-ld-1) < n/d < 2^(ln-ld+1) p0 = max minEx (ln - ld) (n', d') @@ -1123,6 +1123,46 @@ fromRat'' minEx@(I# me#) mantDigs@(I# md#) n d = GT -> q+1 in encodeFloat rdq p' +-- Assumption: Integer and Int# are strictly positive, Int# is less +-- than logBase 2 of Integer, otherwise havoc ensues. +-- Used only for the numerator in fromRational when the denominator +-- is a power of 2. +-- The Int# argument is log2 n minus the number of bits in the mantissa +-- of the target type, i.e. the index of the first non-integral bit in +-- the quotient. +-- +-- 0# means round down (towards zero) +-- 1# means we have a half-integer, round to even +-- 2# means round up (away from zero) +roundingMode# :: Integer -> Int# -> Int# +roundingMode# (IS i#) t = + let + k = int2Word# i# `and#` ((uncheckedShiftL# 2## t) `minusWord#` 1##) + c = uncheckedShiftL# 1## t + in if isTrue# (c `gtWord#` k) + then 0# + else if isTrue# (c `ltWord#` k) + then 2# + else 1# + +roundingMode# (IN bn) t = roundingMode# (IP bn) t -- dummy +roundingMode# (IP bn) t = + let + j = word2Int# (int2Word# t `and#` MMASK##) -- index of relevant bit in word + k = uncheckedIShiftRA# t WSHIFT# -- index of relevant word + r = bigNatIndex# bn k `and#` ((uncheckedShiftL# 2## j) `minusWord#` 1##) + c = uncheckedShiftL# 1## j + test i = if isTrue# (i <# 0#) + then 1# + else case bigNatIndex# bn i of + 0## -> test (i -# 1#) + _ -> 2# + in if isTrue# (c `gtWord#` r) + then 0# + else if isTrue# (c `ltWord#` r) + then 2# + else test (k -# 1#) + ------------------------------------------------------------------------ -- Floating point numeric primops ------------------------------------------------------------------------ diff --git a/libraries/base/GHC/Float/ConversionUtils.hs b/libraries/base/GHC/Float/ConversionUtils.hs index 9a02e4cd78..5b7036f503 100644 --- a/libraries/base/GHC/Float/ConversionUtils.hs +++ b/libraries/base/GHC/Float/ConversionUtils.hs @@ -22,7 +22,7 @@ module GHC.Float.ConversionUtils ( elimZerosInteger, elimZerosInt# ) where import GHC.Base -import GHC.Integer +import GHC.Num.Integer #if WORD_SIZE_IN_BITS < 64 import GHC.IntWord64 #endif @@ -31,7 +31,7 @@ default () #if WORD_SIZE_IN_BITS < 64 -#define TO64 integerToInt64 +#define TO64 integerToInt64# toByte64# :: Int64# -> Int# toByte64# i = word2Int# (and# 255## (int2Word# (int64ToInt# i))) @@ -40,13 +40,13 @@ toByte64# i = word2Int# (and# 255## (int2Word# (int64ToInt# i))) elim64# :: Int64# -> Int# -> (# Integer, Int# #) elim64# n e = case zeroCount (toByte64# n) of - t | isTrue# (e <=# t) -> (# int64ToInteger (uncheckedIShiftRA64# n e), 0# #) - | isTrue# (t <# 8#) -> (# int64ToInteger (uncheckedIShiftRA64# n t), e -# t #) + t | isTrue# (e <=# t) -> (# integerFromInt64# (uncheckedIShiftRA64# n e), 0# #) + | isTrue# (t <# 8#) -> (# integerFromInt64# (uncheckedIShiftRA64# n t), e -# t #) | otherwise -> elim64# (uncheckedIShiftRA64# n 8#) (e -# 8#) #else -#define TO64 integerToInt +#define TO64 integerToInt# -- Double mantissae fit it Int# elim64# :: Int# -> Int# -> (# Integer, Int# #) @@ -61,8 +61,8 @@ elimZerosInteger m e = elim64# (TO64 m) e elimZerosInt# :: Int# -> Int# -> (# Integer, Int# #) elimZerosInt# n e = case zeroCount (toByte# n) of - t | isTrue# (e <=# t) -> (# smallInteger (uncheckedIShiftRA# n e), 0# #) - | isTrue# (t <# 8#) -> (# smallInteger (uncheckedIShiftRA# n t), e -# t #) + t | isTrue# (e <=# t) -> (# IS (uncheckedIShiftRA# n e), 0# #) + | isTrue# (t <# 8#) -> (# IS (uncheckedIShiftRA# n t), e -# t #) | otherwise -> elimZerosInt# (uncheckedIShiftRA# n 8#) (e -# 8#) {-# INLINE zeroCount #-} diff --git a/libraries/base/GHC/Float/RealFracMethods.hs b/libraries/base/GHC/Float/RealFracMethods.hs index 9a31425f64..91756419e2 100644 --- a/libraries/base/GHC/Float/RealFracMethods.hs +++ b/libraries/base/GHC/Float/RealFracMethods.hs @@ -54,7 +54,7 @@ module GHC.Float.RealFracMethods , int2Float ) where -import GHC.Integer +import GHC.Num.Integer import GHC.Base import GHC.Num () @@ -63,15 +63,15 @@ import GHC.Num () import GHC.IntWord64 -#define TO64 integerToInt64 -#define FROM64 int64ToInteger +#define TO64 integerToInt64# +#define FROM64 integerFromInt64# #define MINUS64 minusInt64# #define NEGATE64 negateInt64# #else -#define TO64 integerToInt -#define FROM64 smallInteger +#define TO64 integerToInt# +#define FROM64 IS #define MINUS64 ( -# ) #define NEGATE64 negateInt# @@ -140,15 +140,15 @@ properFractionFloatInteger v@(F# x) = s | isTrue# (s ># 23#) -> (0, v) | isTrue# (m <# 0#) -> case negateInt# (negateInt# m `uncheckedIShiftRA#` s) of - k -> (smallInteger k, + k -> (IS k, case m -# (k `uncheckedIShiftL#` s) of - r -> F# (encodeFloatInteger (smallInteger r) e)) + r -> F# (integerEncodeFloat# (IS r) e)) | otherwise -> case m `uncheckedIShiftRL#` s of - k -> (smallInteger k, + k -> (IS k, case m -# (k `uncheckedIShiftL#` s) of - r -> F# (encodeFloatInteger (smallInteger r) e)) - | otherwise -> (shiftLInteger (smallInteger m) e, F# 0.0#) + r -> F# (integerEncodeFloat# (IS r) e)) + | otherwise -> (integerShiftL# (IS m) (int2Word# e), F# 0.0#) {-# INLINE truncateFloatInteger #-} truncateFloatInteger :: Float -> Integer @@ -166,8 +166,8 @@ floorFloatInteger (F# x) = | isTrue# (e <# 0#) -> case negateInt# e of s | isTrue# (s ># 23#) -> if isTrue# (m <# 0#) then (-1) else 0 - | otherwise -> smallInteger (m `uncheckedIShiftRA#` s) - | otherwise -> shiftLInteger (smallInteger m) e + | otherwise -> IS (m `uncheckedIShiftRA#` s) + | otherwise -> integerShiftL# (IS m) (int2Word# e) -- ceiling x = -floor (-x) -- If giving this its own implementation is faster at all, @@ -175,7 +175,7 @@ floorFloatInteger (F# x) = {-# INLINE ceilingFloatInteger #-} ceilingFloatInteger :: Float -> Integer ceilingFloatInteger (F# x) = - negateInteger (floorFloatInteger (F# (negateFloat# x))) + integerNegate (floorFloatInteger (F# (negateFloat# x))) {-# INLINE roundFloatInteger #-} roundFloatInteger :: Float -> Integer @@ -231,28 +231,28 @@ roundDoubleInt x = double2Int (c_rintDouble x) {-# INLINE properFractionDoubleInteger #-} properFractionDoubleInteger :: Double -> (Integer, Double) properFractionDoubleInteger v@(D# x) = - case decodeDoubleInteger x of + case integerDecodeDouble# x of (# m, e #) | isTrue# (e <# 0#) -> case negateInt# e of s | isTrue# (s ># 52#) -> (0, v) | m < 0 -> - case TO64 (negateInteger m) of + case TO64 (integerNegate m) of n -> case n `uncheckedIShiftRA64#` s of k -> (FROM64 (NEGATE64 k), case MINUS64 n (k `uncheckedIShiftL64#` s) of r -> - D# (encodeDoubleInteger (FROM64 (NEGATE64 r)) e)) + D# (integerEncodeDouble# (FROM64 (NEGATE64 r)) e)) | otherwise -> case TO64 m of n -> case n `uncheckedIShiftRA64#` s of k -> (FROM64 k, case MINUS64 n (k `uncheckedIShiftL64#` s) of - r -> D# (encodeDoubleInteger (FROM64 r) e)) - | otherwise -> (shiftLInteger m e, D# 0.0##) + r -> D# (integerEncodeDouble# (FROM64 r) e)) + | otherwise -> (integerShiftL# m (int2Word# e), D# 0.0##) {-# INLINE truncateDoubleInteger #-} truncateDoubleInteger :: Double -> Integer @@ -265,7 +265,7 @@ truncateDoubleInteger x = {-# INLINE floorDoubleInteger #-} floorDoubleInteger :: Double -> Integer floorDoubleInteger (D# x) = - case decodeDoubleInteger x of + case integerDecodeDouble# x of (# m, e #) | isTrue# (e <# 0#) -> case negateInt# e of @@ -273,12 +273,12 @@ floorDoubleInteger (D# x) = | otherwise -> case TO64 m of n -> FROM64 (n `uncheckedIShiftRA64#` s) - | otherwise -> shiftLInteger m e + | otherwise -> integerShiftL# m (int2Word# e) {-# INLINE ceilingDoubleInteger #-} ceilingDoubleInteger :: Double -> Integer ceilingDoubleInteger (D# x) = - negateInteger (floorDoubleInteger (D# (negateDouble# x))) + integerNegate (floorDoubleInteger (D# (negateDouble# x))) {-# INLINE roundDoubleInteger #-} roundDoubleInteger :: Double -> Integer @@ -310,20 +310,20 @@ int2Float (I# i) = F# (int2Float# i) {-# INLINE double2Integer #-} double2Integer :: Double -> Integer double2Integer (D# x) = - case decodeDoubleInteger x of + case integerDecodeDouble# x of (# m, e #) | isTrue# (e <# 0#) -> case TO64 m of n -> FROM64 (n `uncheckedIShiftRA64#` negateInt# e) - | otherwise -> shiftLInteger m e + | otherwise -> integerShiftL# m (int2Word# e) {-# INLINE float2Integer #-} float2Integer :: Float -> Integer float2Integer (F# x) = case decodeFloat_Int# x of (# m, e #) - | isTrue# (e <# 0#) -> smallInteger (m `uncheckedIShiftRA#` negateInt# e) - | otherwise -> shiftLInteger (smallInteger m) e + | isTrue# (e <# 0#) -> IS (m `uncheckedIShiftRA#` negateInt# e) + | otherwise -> integerShiftL# (IS m) (int2Word# e) -- Foreign imports, the rounding is done faster in C when the value -- isn't integral, so we call out for rounding. For values of large diff --git a/libraries/base/GHC/Generics.hs b/libraries/base/GHC/Generics.hs index f305e09ea3..c175d9ee7b 100644 --- a/libraries/base/GHC/Generics.hs +++ b/libraries/base/GHC/Generics.hs @@ -730,7 +730,7 @@ module GHC.Generics ( import Data.Either ( Either (..) ) import Data.Maybe ( Maybe(..), fromMaybe ) import Data.Ord ( Down(..) ) -import GHC.Integer ( Integer, integerToInt ) +import GHC.Num.Integer ( Integer, integerToInt ) import GHC.Prim ( Addr#, Char#, Double#, Float#, Int#, Word# ) import GHC.Ptr ( Ptr ) import GHC.Types @@ -1571,7 +1571,7 @@ instance (SingI a, KnownNat n) => SingI ('InfixI a n) where instance SingKind FixityI where type DemoteRep FixityI = Fixity fromSing SPrefix = Prefix - fromSing (SInfix a n) = Infix (fromSing a) (I# (integerToInt n)) + fromSing (SInfix a n) = Infix (fromSing a) (integerToInt n) -- Singleton Associativity data instance Sing (a :: Associativity) where diff --git a/libraries/base/GHC/IO.hs-boot b/libraries/base/GHC/IO.hs-boot index 1aeadd5932..a562b1906f 100644 --- a/libraries/base/GHC/IO.hs-boot +++ b/libraries/base/GHC/IO.hs-boot @@ -4,7 +4,7 @@ module GHC.IO where import GHC.Types -import GHC.Integer () -- See Note [Depend on GHC.Integer] in GHC.Base +import GHC.Num.Integer () -- See Note [Depend on GHC.Num.Integer] in GHC.Base import {-# SOURCE #-} GHC.Exception.Type (SomeException) mplusIO :: IO a -> IO a -> IO a diff --git a/libraries/base/GHC/Int.hs b/libraries/base/GHC/Int.hs index 71bc3f0ce4..1614481e89 100644 --- a/libraries/base/GHC/Int.hs +++ b/libraries/base/GHC/Int.hs @@ -101,7 +101,7 @@ instance Num Int8 where signum x | x > 0 = 1 signum 0 = 0 signum _ = -1 - fromInteger i = I8# (narrow8Int# (integerToInt i)) + fromInteger i = I8# (narrow8Int# (integerToInt# i)) -- | @since 2.01 instance Real Int8 where @@ -155,7 +155,7 @@ instance Integral Int8 where (# d, m #) -> (I8# (narrow8Int# d), I8# (narrow8Int# m)) - toInteger (I8# x#) = smallInteger x# + toInteger (I8# x#) = IS x# -- | @since 2.01 instance Bounded Int8 where @@ -308,7 +308,7 @@ instance Num Int16 where signum x | x > 0 = 1 signum 0 = 0 signum _ = -1 - fromInteger i = I16# (narrow16Int# (integerToInt i)) + fromInteger i = I16# (narrow16Int# (integerToInt# i)) -- | @since 2.01 instance Real Int16 where @@ -362,7 +362,7 @@ instance Integral Int16 where (# d, m #) -> (I16# (narrow16Int# d), I16# (narrow16Int# m)) - toInteger (I16# x#) = smallInteger x# + toInteger (I16# x#) = IS x# -- | @since 2.01 instance Bounded Int16 where @@ -520,7 +520,7 @@ instance Num Int32 where signum x | x > 0 = 1 signum 0 = 0 signum _ = -1 - fromInteger i = I32# (narrow32Int# (integerToInt i)) + fromInteger i = I32# (narrow32Int# (integerToInt# i)) -- | @since 2.01 instance Enum Int32 where @@ -582,7 +582,7 @@ instance Integral Int32 where (# d, m #) -> (I32# (narrow32Int# d), I32# (narrow32Int# m)) - toInteger (I32# x#) = smallInteger x# + toInteger (I32# x#) = IS x# -- | @since 2.01 instance Read Int32 where @@ -743,7 +743,7 @@ instance Num Int64 where signum x | x > 0 = 1 signum 0 = 0 signum _ = -1 - fromInteger i = I64# (integerToInt64 i) + fromInteger i = I64# (integerToInt64# i) -- | @since 2.01 instance Enum Int64 where @@ -799,7 +799,7 @@ instance Integral Int64 where | y == (-1) && x == minBound = (overflowError, 0) | otherwise = (I64# (x# `divInt64#` y#), I64# (x# `modInt64#` y#)) - toInteger (I64# x) = int64ToInteger x + toInteger (I64# x) = integerFromInt64# x divInt64#, modInt64# :: Int64# -> Int64# -> Int64# @@ -948,7 +948,7 @@ instance Num Int64 where signum x | x > 0 = 1 signum 0 = 0 signum _ = -1 - fromInteger i = I64# (integerToInt i) + fromInteger i = I64# (integerToInt# i) -- | @since 2.01 instance Enum Int64 where @@ -1001,7 +1001,7 @@ instance Integral Int64 where | otherwise = case x# `divModInt#` y# of (# d, m #) -> (I64# d, I64# m) - toInteger (I64# x#) = smallInteger x# + toInteger (I64# x#) = IS x# -- | @since 2.01 instance Read Int64 where @@ -1128,11 +1128,11 @@ instance Ix Int64 where {-# RULES "fromIntegral/Int8->Natural" - fromIntegral = intToNatural . (fromIntegral :: Int8 -> Int) + fromIntegral = naturalFromIntUnsafe . (fromIntegral :: Int8 -> Int) "fromIntegral/Int16->Natural" - fromIntegral = intToNatural . (fromIntegral :: Int16 -> Int) + fromIntegral = naturalFromIntUnsafe . (fromIntegral :: Int16 -> Int) "fromIntegral/Int32->Natural" - fromIntegral = intToNatural . (fromIntegral :: Int32 -> Int) + fromIntegral = naturalFromIntUnsafe . (fromIntegral :: Int32 -> Int) #-} #if WORD_SIZE_IN_BITS == 64 @@ -1141,7 +1141,7 @@ instance Ix Int64 where "fromIntegral/Natural->Int64" fromIntegral = (fromIntegral :: Int -> Int64) . naturalToInt "fromIntegral/Int64->Natural" - fromIntegral = intToNatural . (fromIntegral :: Int64 -> Int) + fromIntegral = naturalFromIntUnsafe . (fromIntegral :: Int64 -> Int) #-} #endif diff --git a/libraries/base/GHC/Integer.hs b/libraries/base/GHC/Integer.hs new file mode 100644 index 0000000000..598fe33c6d --- /dev/null +++ b/libraries/base/GHC/Integer.hs @@ -0,0 +1,219 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE NoImplicitPrelude #-} + +{-# OPTIONS_HADDOCK not-home #-} + +#include "MachDeps.h" + +-- | Compatibility module for pre ghc-bignum code. +module GHC.Integer ( + Integer, + + -- * Construct 'Integer's + smallInteger, wordToInteger, +#if WORD_SIZE_IN_BITS < 64 + word64ToInteger, int64ToInteger, +#endif + -- * Conversion to other integral types + integerToWord, integerToInt, +#if WORD_SIZE_IN_BITS < 64 + integerToWord64, integerToInt64, +#endif + + -- * Helpers for 'RealFloat' type-class operations + encodeFloatInteger, floatFromInteger, + encodeDoubleInteger, decodeDoubleInteger, doubleFromInteger, + + -- * Arithmetic operations + plusInteger, minusInteger, timesInteger, negateInteger, + absInteger, signumInteger, + + divModInteger, divInteger, modInteger, + quotRemInteger, quotInteger, remInteger, + + -- * Comparison predicates + eqInteger, neqInteger, leInteger, gtInteger, ltInteger, geInteger, + compareInteger, + + -- ** 'Int#'-boolean valued versions of comparison predicates + -- + -- | These operations return @0#@ and @1#@ instead of 'False' and + -- 'True' respectively. See + -- <https://gitlab.haskell.org/ghc/ghc/wikis/prim-bool PrimBool wiki-page> + -- for more details + eqInteger#, neqInteger#, leInteger#, gtInteger#, ltInteger#, geInteger#, + + + -- * Bit-operations + andInteger, orInteger, xorInteger, + + complementInteger, + shiftLInteger, shiftRInteger, testBitInteger, + + popCountInteger, bitInteger, + + -- * Hashing + hashInteger, + ) where + +import GHC.Num.Integer (Integer) +import qualified GHC.Num.Integer as I +import GHC.Prim +import GHC.Types + +smallInteger :: Int# -> Integer +smallInteger = I.integerFromInt# + +integerToInt :: Integer -> Int# +integerToInt = I.integerToInt# + +wordToInteger :: Word# -> Integer +wordToInteger = I.integerFromWord# + +integerToWord :: Integer -> Word# +integerToWord = I.integerToWord# + +#if WORD_SIZE_IN_BITS < 64 + +word64ToInteger :: Word64# -> Integer +word64ToInteger = I.integerFromWord64# + +integerToWord64 :: Integer -> Word64# +integerToWord64 = I.integerToWord64# + +int64ToInteger :: Int64# -> Integer +int64ToInteger = I.integerFromInt64# + +integerToInt64 :: Integer -> Int64# +integerToInt64 = I.integerToInt64# + +#endif + + +encodeFloatInteger :: Integer -> Int# -> Float# +encodeFloatInteger = I.integerEncodeFloat# + +floatFromInteger :: Integer -> Float# +floatFromInteger = I.integerToFloat# + +encodeDoubleInteger :: Integer -> Int# -> Double# +encodeDoubleInteger = I.integerEncodeDouble# + +doubleFromInteger :: Integer -> Double# +doubleFromInteger = I.integerToDouble# + +decodeDoubleInteger :: Double# -> (# Integer, Int# #) +decodeDoubleInteger = I.integerDecodeDouble# + + +plusInteger :: Integer -> Integer -> Integer +plusInteger = I.integerAdd + +minusInteger :: Integer -> Integer -> Integer +minusInteger = I.integerSub + +timesInteger :: Integer -> Integer -> Integer +timesInteger = I.integerMul + +negateInteger :: Integer -> Integer +negateInteger = I.integerNegate + +absInteger :: Integer -> Integer +absInteger = I.integerAbs + +signumInteger :: Integer -> Integer +signumInteger = I.integerSignum + +divModInteger :: Integer -> Integer -> (# Integer, Integer #) +divModInteger = I.integerDivMod# + +divInteger :: Integer -> Integer -> Integer +divInteger = I.integerDiv + +modInteger :: Integer -> Integer -> Integer +modInteger = I.integerMod + +quotRemInteger :: Integer -> Integer -> (# Integer, Integer #) +quotRemInteger = I.integerQuotRem# + +quotInteger :: Integer -> Integer -> Integer +quotInteger = I.integerQuot + +remInteger :: Integer -> Integer -> Integer +remInteger = I.integerRem + + +eqInteger :: Integer -> Integer -> Bool +eqInteger = I.integerEq + +neqInteger :: Integer -> Integer -> Bool +neqInteger = I.integerNe + +leInteger :: Integer -> Integer -> Bool +leInteger = I.integerLe + +gtInteger :: Integer -> Integer -> Bool +gtInteger = I.integerGt + +ltInteger :: Integer -> Integer -> Bool +ltInteger = I.integerLt + +geInteger :: Integer -> Integer -> Bool +geInteger = I.integerGe + +compareInteger :: Integer -> Integer -> Ordering +compareInteger = I.integerCompare + + + +eqInteger# :: Integer -> Integer -> Int# +eqInteger# = I.integerEq# + +neqInteger# :: Integer -> Integer -> Int# +neqInteger# = I.integerNe# + +leInteger# :: Integer -> Integer -> Int# +leInteger# = I.integerLe# + +gtInteger# :: Integer -> Integer -> Int# +gtInteger# = I.integerGt# + +ltInteger# :: Integer -> Integer -> Int# +ltInteger# = I.integerLt# + +geInteger# :: Integer -> Integer -> Int# +geInteger# = I.integerGe# + + +andInteger :: Integer -> Integer -> Integer +andInteger = I.integerAnd + +orInteger :: Integer -> Integer -> Integer +orInteger = I.integerOr + +xorInteger :: Integer -> Integer -> Integer +xorInteger = I.integerXor + +complementInteger :: Integer -> Integer +complementInteger = I.integerComplement + +shiftLInteger :: Integer -> Int# -> Integer +shiftLInteger n i = I.integerShiftL# n (int2Word# i) + +shiftRInteger :: Integer -> Int# -> Integer +shiftRInteger n i = I.integerShiftR# n (int2Word# i) + +testBitInteger :: Integer -> Int# -> Bool +testBitInteger n i = isTrue# (I.integerTestBit# n (int2Word# i)) + +hashInteger :: Integer -> Int# +hashInteger = I.integerToInt# + +bitInteger :: Int# -> Integer +bitInteger i = I.integerBit# (int2Word# i) + +popCountInteger :: Integer -> Int# +popCountInteger = I.integerPopCount# + diff --git a/libraries/base/GHC/Integer/Logarithms.hs b/libraries/base/GHC/Integer/Logarithms.hs new file mode 100644 index 0000000000..61e2322ebb --- /dev/null +++ b/libraries/base/GHC/Integer/Logarithms.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE MagicHash #-} + +-- | Compatibility module for pre ghc-bignum code. +module GHC.Integer.Logarithms + ( wordLog2# + , integerLog2# + , integerLogBase# + ) +where + +import qualified GHC.Num.Primitives as N +import qualified GHC.Num.Integer as N +import GHC.Num.Integer (Integer) +import GHC.Prim + +wordLog2# :: Word# -> Int# +wordLog2# i = word2Int# (N.wordLog2# i) + +integerLog2# :: Integer -> Int# +integerLog2# i = word2Int# (N.integerLog2# i) + +integerLogBase# :: Integer -> Integer -> Int# +integerLogBase# x y = word2Int# (N.integerLogBase# x y) diff --git a/libraries/base/GHC/List.hs b/libraries/base/GHC/List.hs index 0252c86375..f3f2ad5909 100644 --- a/libraries/base/GHC/List.hs +++ b/libraries/base/GHC/List.hs @@ -36,7 +36,7 @@ module GHC.List ( import Data.Maybe import GHC.Base import GHC.Num (Num(..)) -import GHC.Integer (Integer) +import GHC.Num.Integer (Integer) infixl 9 !! infix 4 `elem`, `notElem` diff --git a/libraries/base/GHC/Maybe.hs b/libraries/base/GHC/Maybe.hs index 4624560ca7..0e45e80707 100644 --- a/libraries/base/GHC/Maybe.hs +++ b/libraries/base/GHC/Maybe.hs @@ -7,7 +7,7 @@ module GHC.Maybe ) where -import GHC.Integer () -- See Note [Depend on GHC.Integer] in GHC.Base +import GHC.Num.Integer () -- See Note [Depend on GHC.Num.Integer] in GHC.Base import GHC.Classes default () diff --git a/libraries/base/GHC/Natural.hs b/libraries/base/GHC/Natural.hs index 5912f75e29..4d5a935e7c 100644 --- a/libraries/base/GHC/Natural.hs +++ b/libraries/base/GHC/Natural.hs @@ -1,155 +1,82 @@ +{-# LANGUAGE Trustworthy #-} {-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} -{-# LANGUAGE UnboxedTuples #-} - ------------------------------------------------------------------------------ --- | --- 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 ------------------------------------------------------------------------------ +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE UnboxedSums #-} + +{-# OPTIONS_HADDOCK not-home #-} + +-- | Compatibility module for pre ghc-bignum code. 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(..) - , mkNatural - , isValidNatural - -- * Arithmetic - , plusNatural - , minusNatural - , minusNaturalMaybe - , timesNatural - , negateNatural - , signumNatural - , quotRemNatural - , quotNatural - , remNatural - , gcdNatural - , lcmNatural - -- * Bits - , andNatural - , orNatural - , xorNatural - , bitNatural - , testBitNatural - , popCountNatural - , shiftLNatural - , shiftRNatural - -- * Conversions - , naturalToInteger - , naturalToWord - , naturalToInt - , naturalFromInteger - , wordToNatural - , intToNatural - , naturalToWordMaybe - , wordToNatural# - , wordToNaturalBase - -- * Modular arithmetic - , powModNatural - ) where - -#include "MachDeps.h" - -import GHC.Classes -import GHC.Maybe -import GHC.Types + ( Natural (NatS#, NatJ#) + , BigNat (..) + , mkNatural + , isValidNatural + -- * Arithmetic + , plusNatural + , minusNatural + , minusNaturalMaybe + , timesNatural + , negateNatural + , signumNatural + , quotRemNatural + , quotNatural + , remNatural + , gcdNatural + , lcmNatural + -- * Bits + , andNatural + , orNatural + , xorNatural + , bitNatural + , testBitNatural + , popCountNatural + , shiftLNatural + , shiftRNatural + -- * Conversions + , naturalToInteger + , naturalToWord + , naturalToInt + , naturalFromInteger + , wordToNatural + , intToNatural + , naturalToWordMaybe + , wordToNatural# + -- * Modular arithmetic + , powModNatural + ) +where + 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 () - --- Most high-level operations need to be marked `NOINLINE` as --- otherwise GHC doesn't recognize them and fails to apply constant --- folding to `Natural`-typed expression. --- --- To this end, the CPP hack below allows to write the pseudo-pragma --- --- {-# CONSTANT_FOLDED plusNatural #-} --- --- which is simply expanded into a --- --- {-# NOINLINE plusNatural #-} --- --- --- TODO: Note that some functions have commented CONSTANT_FOLDED annotations, --- that's because the Integer counter-parts of these functions do actually have --- a builtinRule in PrelRules, where the Natural functions do not. The plan is --- to eventually also add builtin rules for those functions on Natural. -#define CONSTANT_FOLDED NOINLINE +import GHC.Types +import GHC.Maybe +import GHC.Num.Natural (Natural) +import GHC.Num.Integer (Integer) +import qualified GHC.Num.Natural as N +import qualified GHC.Num.Integer as I -------------------------------------------------------------------------------- --- Arithmetic underflow -------------------------------------------------------------------------------- +data BigNat = BN# { unBigNat :: ByteArray# } --- We put them here because they are needed relatively early --- in the libraries before the Exception type has been defined yet. +{-# COMPLETE NatS#, NatJ# #-} -{-# NOINLINE underflowError #-} -underflowError :: a -underflowError = raise# underflowException +pattern NatS# :: Word# -> Natural +pattern NatS# w = N.NS w -{-# NOINLINE divZeroError #-} -divZeroError :: a -divZeroError = raise# divZeroException +pattern NatJ# :: BigNat -> Natural +pattern NatJ# b <- N.NB (BN# -> b) + where + NatJ# b = N.NB (unBigNat b) -------------------------------------------------------------------------------- --- Natural type -------------------------------------------------------------------------------- +int2Word :: Int -> Word +int2Word (I# i) = W# (int2Word# i) -#if defined(MIN_VERSION_integer_gmp) --- TODO: if saturated arithmetic is to used, replace 'underflowError' by '0' +word2Int :: Word -> Int +word2Int (W# w) = I# (word2Int# w) --- | Type representing arbitrary-precision non-negative integers. --- --- >>> 2^100 :: Natural --- 1267650600228229401496703205376 --- --- Operations whose result would be negative @'Control.Exception.throw' --- ('Control.Exception.Underflow' :: 'Control.Exception.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. - -- NB: Order of constructors *must* - -- coincide with 'Ord' relation - deriving ( Eq -- ^ @since 4.8.0.0 - , Ord -- ^ @since 4.8.0.0 - ) - -zero, one :: Natural -zero = NatS# 0## -one = NatS# 1## +-- | Construct 'Natural' value from list of 'Word's. +mkNatural :: [Word] -> Natural +mkNatural = N.naturalFromWordList -- | Test whether all internal invariants are satisfied by 'Natural' value -- @@ -158,477 +85,114 @@ one = NatS# 1## -- -- @since 4.8.0.0 isValidNatural :: Natural -> Bool -isValidNatural (NatS# _) = True -isValidNatural (NatJ# bn) = isTrue# (isValidBigNat# bn) - -- A 1-limb BigNat could fit into a NatS#, so we - -- require at least 2 limbs. - && isTrue# (sizeofBigNat# bn ># 1#) - -signumNatural :: Natural -> Natural -signumNatural (NatS# 0##) = zero -signumNatural _ = one --- {-# CONSTANT_FOLDED signumNatural #-} - -negateNatural :: Natural -> Natural -negateNatural (NatS# 0##) = zero -negateNatural _ = underflowError --- {-# CONSTANT_FOLDED negateNatural #-} - --- | @since 4.10.0.0 -naturalFromInteger :: Integer -> Natural -naturalFromInteger (S# i#) - | isTrue# (i# >=# 0#) = NatS# (int2Word# i#) -naturalFromInteger (Jp# bn) = bigNatToNatural bn -naturalFromInteger _ = underflowError -{-# CONSTANT_FOLDED naturalFromInteger #-} - --- | Compute greatest common divisor. -gcdNatural :: Natural -> Natural -> Natural -gcdNatural (NatS# 0##) y = y -gcdNatural x (NatS# 0##) = x -gcdNatural (NatS# 1##) _ = one -gcdNatural _ (NatS# 1##) = one -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 multiple. -lcmNatural :: Natural -> Natural -> Natural --- Make sure we are strict in all arguments (#17499) -lcmNatural (NatS# 0##) !_ = zero -lcmNatural _ (NatS# 0##) = zero -lcmNatural (NatS# 1##) y = y -lcmNatural x (NatS# 1##) = x -lcmNatural x y = (x `quotNatural` (gcdNatural x y)) `timesNatural` y - ----------------------------------------------------------------------------- - -quotRemNatural :: Natural -> Natural -> (Natural, Natural) --- Make sure we are strict in all arguments (#17499) -quotRemNatural !_ (NatS# 0##) = divZeroError -quotRemNatural n (NatS# 1##) = (n,zero) -quotRemNatural n@(NatS# _) (NatJ# _) = (zero, n) -quotRemNatural (NatS# n) (NatS# d) = case quotRemWord# n d of - (# q, r #) -> (NatS# q, NatS# r) -quotRemNatural (NatJ# n) (NatS# d) = case quotRemBigNatWord n d of - (# q, r #) -> (bigNatToNatural q, NatS# r) -quotRemNatural (NatJ# n) (NatJ# d) = case quotRemBigNat n d of - (# q, r #) -> (bigNatToNatural q, bigNatToNatural r) --- {-# CONSTANT_FOLDED quotRemNatural #-} - -quotNatural :: Natural -> Natural -> Natural --- Make sure we are strict in all arguments (#17499) -quotNatural !_ (NatS# 0##) = divZeroError -quotNatural n (NatS# 1##) = n -quotNatural (NatS# _) (NatJ# _) = zero -quotNatural (NatS# n) (NatS# d) = NatS# (quotWord# n d) -quotNatural (NatJ# n) (NatS# d) = bigNatToNatural (quotBigNatWord n d) -quotNatural (NatJ# n) (NatJ# d) = bigNatToNatural (quotBigNat n d) --- {-# CONSTANT_FOLDED quotNatural #-} - -remNatural :: Natural -> Natural -> Natural --- Make sure we are strict in all arguments (#17499) -remNatural !_ (NatS# 0##) = divZeroError -remNatural _ (NatS# 1##) = zero -remNatural n@(NatS# _) (NatJ# _) = n -remNatural (NatS# n) (NatS# d) = NatS# (remWord# n d) -remNatural (NatJ# n) (NatS# d) = NatS# (remBigNatWord n d) -remNatural (NatJ# n) (NatJ# d) = bigNatToNatural (remBigNat n d) --- {-# CONSTANT_FOLDED remNatural #-} - --- | @since 4.12.0.0 -naturalToInteger :: Natural -> Integer -naturalToInteger (NatS# w) = wordToInteger w -naturalToInteger (NatJ# bn) = Jp# bn -{-# CONSTANT_FOLDED naturalToInteger #-} - -andNatural :: Natural -> Natural -> Natural -andNatural (NatS# n) (NatS# m) = NatS# (n `and#` m) -andNatural (NatS# n) (NatJ# m) = NatS# (n `and#` bigNatToWord m) -andNatural (NatJ# n) (NatS# m) = NatS# (bigNatToWord n `and#` m) -andNatural (NatJ# n) (NatJ# m) = bigNatToNatural (andBigNat n m) --- {-# CONSTANT_FOLDED andNatural #-} - -orNatural :: Natural -> Natural -> Natural -orNatural (NatS# n) (NatS# m) = NatS# (n `or#` m) -orNatural (NatS# n) (NatJ# m) = NatJ# (orBigNat (wordToBigNat n) m) -orNatural (NatJ# n) (NatS# m) = NatJ# (orBigNat n (wordToBigNat m)) -orNatural (NatJ# n) (NatJ# m) = NatJ# (orBigNat n m) --- {-# CONSTANT_FOLDED orNatural #-} - -xorNatural :: Natural -> Natural -> Natural -xorNatural (NatS# n) (NatS# m) = NatS# (n `xor#` m) -xorNatural (NatS# n) (NatJ# m) = NatJ# (xorBigNat (wordToBigNat n) m) -xorNatural (NatJ# n) (NatS# m) = NatJ# (xorBigNat n (wordToBigNat m)) -xorNatural (NatJ# n) (NatJ# m) = bigNatToNatural (xorBigNat n m) --- {-# CONSTANT_FOLDED xorNatural #-} - -bitNatural :: Int# -> Natural -bitNatural i# - | isTrue# (i# <# WORD_SIZE_IN_BITS#) = NatS# (1## `uncheckedShiftL#` i#) - | True = NatJ# (bitBigNat i#) --- {-# CONSTANT_FOLDED bitNatural #-} - -testBitNatural :: Natural -> Int -> Bool -testBitNatural (NatS# w) (I# i#) - | isTrue# (i# <# WORD_SIZE_IN_BITS#) = - isTrue# ((w `and#` (1## `uncheckedShiftL#` i#)) `neWord#` 0##) - | True = False -testBitNatural (NatJ# bn) (I# i#) = testBitBigNat bn i# --- {-# CONSTANT_FOLDED testBitNatural #-} - -popCountNatural :: Natural -> Int -popCountNatural (NatS# w) = I# (word2Int# (popCnt# w)) -popCountNatural (NatJ# bn) = I# (popCountBigNat bn) --- {-# CONSTANT_FOLDED popCountNatural #-} - -shiftLNatural :: Natural -> Int -> Natural -shiftLNatural n (I# 0#) = n -shiftLNatural (NatS# 0##) _ = zero -shiftLNatural (NatS# 1##) (I# i#) = bitNatural i# -shiftLNatural (NatS# w) (I# i#) - = bigNatToNatural (shiftLBigNat (wordToBigNat w) i#) -shiftLNatural (NatJ# bn) (I# i#) - = bigNatToNatural (shiftLBigNat bn i#) --- {-# CONSTANT_FOLDED shiftLNatural #-} - -shiftRNatural :: Natural -> Int -> Natural -shiftRNatural n (I# 0#) = n -shiftRNatural (NatS# w) (I# i#) - | isTrue# (i# >=# WORD_SIZE_IN_BITS#) = zero - | True = NatS# (w `uncheckedShiftRL#` i#) -shiftRNatural (NatJ# bn) (I# i#) = bigNatToNatural (shiftRBigNat bn i#) --- {-# CONSTANT_FOLDED shiftRNatural #-} - ----------------------------------------------------------------------------- +isValidNatural = N.naturalCheck -- | '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) -{-# CONSTANT_FOLDED plusNatural #-} - --- | 'Natural' multiplication -timesNatural :: Natural -> Natural -> Natural --- Make sure we are strict in all arguments (#17499) -timesNatural !_ (NatS# 0##) = zero -timesNatural (NatS# 0##) _ = zero -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) -{-# CONSTANT_FOLDED timesNatural #-} +plusNatural = N.naturalAdd -- | 'Natural' subtraction. May @'Control.Exception.throw' -- 'Control.Exception.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) -{-# CONSTANT_FOLDED minusNatural #-} +minusNatural = N.naturalSubThrow -- | 'Natural' subtraction. Returns 'Nothing's for non-positive results. -- -- @since 4.8.0.0 minusNaturalMaybe :: Natural -> Natural -> Maybe Natural --- Make sure we are strict in all arguments (#17499) -minusNaturalMaybe !x (NatS# 0##) = Just x -minusNaturalMaybe (NatS# x) (NatS# y) = case subWordC# x y of - (# l, 0# #) -> Just (NatS# l) - _ -> Nothing -minusNaturalMaybe (NatS# _) (NatJ# _) = Nothing -minusNaturalMaybe (NatJ# x) (NatS# y) - = Just (bigNatToNatural (minusBigNatWord x y)) -minusNaturalMaybe (NatJ# x) (NatJ# y) - | isTrue# (isNullBigNat# res) = Nothing - | True = Just (bigNatToNatural res) - where - res = minusBigNat x y - --- | Convert 'BigNat' to 'Natural'. --- Throws 'Control.Exception.Underflow' if passed a 'nullBigNat'. -bigNatToNatural :: BigNat -> Natural -bigNatToNatural bn - | isTrue# (sizeofBigNat# bn ==# 1#) = NatS# (bigNatToWord bn) - | isTrue# (isNullBigNat# bn) = underflowError - | True = NatJ# bn - -naturalToBigNat :: Natural -> BigNat -naturalToBigNat (NatS# w#) = wordToBigNat w# -naturalToBigNat (NatJ# bn) = bn - -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) - ----------------------------------------------------------------------------- - --- | Convert a Word# into a Natural --- --- Built-in rule ensures that applications of this function to literal Word# are --- lifted into Natural literals. -wordToNatural# :: Word# -> Natural -wordToNatural# w# = NatS# w# -{-# CONSTANT_FOLDED wordToNatural# #-} - --- | Convert a Word# into a Natural --- --- In base we can't use wordToNatural# as built-in rules transform some of them --- into Natural literals. Use this function instead. -wordToNaturalBase :: Word# -> Natural -wordToNaturalBase w# = NatS# w# - -#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 @'Control.Exception.throw' --- ('Control.Exception.Underflow' :: 'Control.Exception.ArithException')@. --- --- @since 4.8.0.0 -newtype Natural = Natural Integer -- ^ __Invariant__: non-negative 'Integer' - deriving (Eq,Ord) +minusNaturalMaybe x y = case N.naturalSub x y of + (# () | #) -> Nothing + (# | n #) -> Just n +-- | 'Natural' multiplication +timesNatural :: Natural -> Natural -> Natural +timesNatural = N.naturalMul --- | Test whether all internal invariants are satisfied by 'Natural' value --- --- This operation is mostly useful for test-suites and/or code which --- constructs 'Natural' values directly. --- --- @since 4.8.0.0 -isValidNatural :: Natural -> Bool -isValidNatural (Natural i) = i >= wordToInteger 0## +negateNatural :: Natural -> Natural +negateNatural = N.naturalNegate --- | Convert a 'Word#' into a 'Natural' --- --- Built-in rule ensures that applications of this function to literal 'Word#' --- are lifted into 'Natural' literals. -wordToNatural# :: Word# -> Natural -wordToNatural# w## = Natural (wordToInteger w##) -{-# CONSTANT_FOLDED wordToNatural# #-} +signumNatural :: Natural -> Natural +signumNatural = N.naturalSignum --- | Convert a 'Word#' into a Natural --- --- In base we can't use wordToNatural# as built-in rules transform some of them --- into Natural literals. Use this function instead. -wordToNaturalBase :: Word# -> Natural -wordToNaturalBase w## = Natural (wordToInteger w##) +quotRemNatural :: Natural -> Natural -> (Natural, Natural) +quotRemNatural = N.naturalQuotRem --- | @since 4.10.0.0 -naturalFromInteger :: Integer -> Natural -naturalFromInteger n - | n >= wordToInteger 0## = Natural n - | True = underflowError -{-# INLINE naturalFromInteger #-} +remNatural :: Natural -> Natural -> Natural +remNatural = N.naturalRem +quotNatural :: Natural -> Natural -> Natural +quotNatural = N.naturalQuot -- | Compute greatest common divisor. gcdNatural :: Natural -> Natural -> Natural -gcdNatural (Natural n) (Natural m) = Natural (n `gcdInteger` m) +gcdNatural = N.naturalGcd --- | Compute lowest common multiple. +-- | Compute least common multiple. lcmNatural :: Natural -> Natural -> Natural -lcmNatural (Natural n) (Natural m) = Natural (n `lcmInteger` m) - --- | 'Natural' subtraction. Returns 'Nothing's for non-positive results. --- --- @since 4.8.0.0 -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) --- {-# CONSTANT_FOLDED shiftLNatural #-} - -shiftRNatural :: Natural -> Int -> Natural -shiftRNatural (Natural n) (I# i) = Natural (n `shiftRInteger` i) --- {-# CONSTANT_FOLDED shiftRNatural #-} - -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 #-} +lcmNatural = N.naturalLcm -timesNatural :: Natural -> Natural -> Natural -timesNatural (Natural x) (Natural y) = Natural (x `timesInteger` y) -{-# CONSTANT_FOLDED timesNatural #-} +andNatural :: Natural -> Natural -> Natural +andNatural = N.naturalAnd orNatural :: Natural -> Natural -> Natural -orNatural (Natural x) (Natural y) = Natural (x `orInteger` y) --- {-# CONSTANT_FOLDED orNatural #-} +orNatural = N.naturalOr xorNatural :: Natural -> Natural -> Natural -xorNatural (Natural x) (Natural y) = Natural (x `xorInteger` y) --- {-# CONSTANT_FOLDED xorNatural #-} - -andNatural :: Natural -> Natural -> Natural -andNatural (Natural x) (Natural y) = Natural (x `andInteger` y) --- {-# CONSTANT_FOLDED andNatural #-} - -naturalToInt :: Natural -> Int -naturalToInt (Natural i) = I# (integerToInt i) +xorNatural = N.naturalXor -naturalToWord :: Natural -> Word -naturalToWord (Natural i) = W# (integerToWord i) - -naturalToInteger :: Natural -> Integer -naturalToInteger (Natural i) = i -{-# CONSTANT_FOLDED naturalToInteger #-} +bitNatural :: Int# -> Natural +bitNatural i = N.naturalBit# (int2Word# i) testBitNatural :: Natural -> Int -> Bool -testBitNatural (Natural n) (I# i) = testBitInteger n i --- {-# CONSTANT_FOLDED testBitNatural #-} +testBitNatural n i = N.naturalTestBit n (int2Word i) popCountNatural :: Natural -> Int -popCountNatural (Natural n) = I# (popCountInteger n) +popCountNatural n = word2Int (N.naturalPopCount n) -bitNatural :: Int# -> Natural -bitNatural i# - | isTrue# (i# <# WORD_SIZE_IN_BITS#) = wordToNaturalBase (1## `uncheckedShiftL#` i#) - | True = Natural (1 `shiftLInteger` i#) --- {-# CONSTANT_FOLDED bitNatural #-} - -quotNatural :: Natural -> Natural -> Natural -quotNatural n@(Natural x) (Natural y) - | y == wordToInteger 0## = divZeroError - | y == wordToInteger 1## = n - | True = Natural (x `quotInteger` y) --- {-# CONSTANT_FOLDED quotNatural #-} +shiftLNatural :: Natural -> Int -> Natural +shiftLNatural n i = N.naturalShiftL n (int2Word i) -remNatural :: Natural -> Natural -> Natural -remNatural (Natural x) (Natural y) - | y == wordToInteger 0## = divZeroError - | y == wordToInteger 1## = wordToNaturalBase 0## - | True = Natural (x `remInteger` y) --- {-# CONSTANT_FOLDED remNatural #-} +shiftRNatural :: Natural -> Int -> Natural +shiftRNatural n i = N.naturalShiftR n (int2Word i) -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) --- {-# CONSTANT_FOLDED quotRemNatural #-} +-- | @since 4.12.0.0 +naturalToInteger :: Natural -> Integer +naturalToInteger = I.integerFromNatural -signumNatural :: Natural -> Natural -signumNatural (Natural x) - | x == wordToInteger 0## = wordToNaturalBase 0## - | True = wordToNaturalBase 1## --- {-# CONSTANT_FOLDED signumNatural #-} +naturalToWord :: Natural -> Word +naturalToWord = N.naturalToWord -negateNatural :: Natural -> Natural -negateNatural (Natural x) - | x == wordToInteger 0## = wordToNaturalBase 0## - | True = underflowError --- {-# CONSTANT_FOLDED negateNatural #-} +naturalToInt :: Natural -> Int +naturalToInt = N.naturalToInt -#endif +-- | @since 4.10.0.0 +naturalFromInteger :: Integer -> Natural +naturalFromInteger = I.integerToNatural -- | Construct 'Natural' from 'Word' value. -- -- @since 4.8.0.0 wordToNatural :: Word -> Natural -wordToNatural (W# w#) = wordToNatural# w# +wordToNatural = N.naturalFromWord + +intToNatural :: Int -> Natural +intToNatural = N.naturalFromIntThrow -- | 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 (W# (integerToWord i)) - | True = Nothing - where - maxw = 1 `shiftLInteger` WORD_SIZE_IN_BITS# -#endif +naturalToWordMaybe n = case N.naturalToWordMaybe# n of + (# w | #) -> Just (W# w) + (# | () #) -> Nothing + +wordToNatural# :: Word -> Natural +wordToNatural# = N.naturalFromWord -- | \"@'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) --- Make sure we are strict in all arguments (#17499) -powModNatural !_ !_ (NatS# 0##) = divZeroError -powModNatural _ _ (NatS# 1##) = zero -powModNatural _ (NatS# 0##) _ = one -powModNatural (NatS# 0##) _ _ = zero -powModNatural (NatS# 1##) _ _ = one -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 (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# -- slightly faster than "e `div` 2" -#endif - - --- | Construct 'Natural' value from list of 'Word's. --- --- This function is used by GHC for constructing 'Natural' literals. -mkNatural :: [Word] -- ^ value expressed in 32 bit chunks, least - -- significant first - -> Natural -mkNatural [] = wordToNaturalBase 0## -mkNatural (W# i : is') = wordToNaturalBase (i `and#` 0xffffffff##) `orNatural` - shiftLNatural (mkNatural is') 32 -{-# CONSTANT_FOLDED mkNatural #-} - --- | Convert 'Int' to 'Natural'. --- Throws 'Control.Exception.Underflow' when passed a negative 'Int'. -intToNatural :: Int -> Natural -intToNatural (I# i#) - | isTrue# (i# <# 0#) = underflowError - | True = wordToNaturalBase (int2Word# i#) +powModNatural = N.naturalPowMod diff --git a/libraries/base/GHC/Num.hs b/libraries/base/GHC/Num.hs index 023ccb3075..f80f431361 100644 --- a/libraries/base/GHC/Num.hs +++ b/libraries/base/GHC/Num.hs @@ -17,13 +17,25 @@ ----------------------------------------------------------------------------- -module GHC.Num (module GHC.Num, module GHC.Integer, module GHC.Natural) where +module GHC.Num + ( module GHC.Num + , module GHC.Num.Integer + , module GHC.Num.Natural + -- reexported for backward compatibility + , module GHC.Natural + , module GHC.Integer + ) +where #include "MachDeps.h" +import qualified GHC.Natural +import qualified GHC.Integer + import GHC.Base -import GHC.Integer -import GHC.Natural +import GHC.Num.Integer +import GHC.Num.Natural +import {-# SOURCE #-} GHC.Exception.Type infixl 7 * infixl 6 +, - @@ -98,7 +110,7 @@ instance Num Int where | otherwise = 1 {-# INLINE fromInteger #-} -- Just to be sure! - fromInteger i = I# (integerToInt i) + fromInteger i = integerToInt i -- | @since 2.01 instance Num Word where @@ -109,30 +121,43 @@ instance Num Word where abs x = x signum 0 = 0 signum _ = 1 - fromInteger i = W# (integerToWord i) + fromInteger i = integerToWord i -- | @since 2.01 instance Num Integer where - (+) = plusInteger - (-) = minusInteger - (*) = timesInteger - negate = negateInteger - fromInteger x = x + (+) = integerAdd + (-) = integerSub + (*) = integerMul + negate = integerNegate + fromInteger x = x - abs = absInteger - signum = signumInteger + abs = integerAbs + signum = integerSignum -- | Note that `Natural`'s 'Num' instance isn't a ring: no element but 0 has an -- additive inverse. It is a semiring though. -- -- @since 4.8.0.0 instance Num Natural where - (+) = plusNatural - (-) = minusNatural - (*) = timesNatural - negate = negateNatural - fromInteger = naturalFromInteger - - abs = id - signum = signumNatural + (+) = naturalAdd + (-) x y = case compare x y of + EQ -> naturalZero + GT -> naturalSubUnsafe x y + LT -> raise# underflowException + + (*) = naturalMul + negate x + | naturalIsZero x = x + | otherwise = raise# underflowException + + fromInteger x + | x < 0 = raise# underflowException + | otherwise = integerToNaturalClamp x + + abs = id + signum = naturalSignum + +{-# DEPRECATED quotRemInteger "Use integerQuotRem# instead" #-} +quotRemInteger :: Integer -> Integer -> (# Integer, Integer #) +quotRemInteger = integerQuotRem# diff --git a/libraries/base/GHC/Ptr.hs b/libraries/base/GHC/Ptr.hs index e4021ee115..6cbcc07ddc 100644 --- a/libraries/base/GHC/Ptr.hs +++ b/libraries/base/GHC/Ptr.hs @@ -179,7 +179,7 @@ exchangePtr (Ptr dst) (Ptr val) = -- | @since 2.01 instance Show (Ptr a) where - showsPrec _ (Ptr a) rs = pad_out (showHex (wordToInteger(int2Word#(addr2Int# a))) "") + showsPrec _ (Ptr a) rs = pad_out (showHex (integerFromWord#(int2Word#(addr2Int# a))) "") where -- want 0s prefixed to pad it out to a fixed length. pad_out ls = diff --git a/libraries/base/GHC/Real.hs b/libraries/base/GHC/Real.hs index 1425f8c306..4d0b05a5f9 100644 --- a/libraries/base/GHC/Real.hs +++ b/libraries/base/GHC/Real.hs @@ -31,9 +31,7 @@ import {-# SOURCE #-} GHC.Exception( divZeroException, overflowException , underflowException , ratioZeroDenomException ) -#if defined(MIN_VERSION_integer_gmp) -import GHC.Integer.GMP.Internals -#endif +import GHC.Num.BigNat (gcdInt,gcdWord) infixr 8 ^, ^^ infixl 7 /, `quot`, `rem`, `div`, `mod` @@ -326,7 +324,7 @@ instance Real Int where -- | @since 2.0.1 instance Integral Int where - toInteger (I# i) = smallInteger i + toInteger (I# i) = IS i a `quot` b | b == 0 = divZeroError @@ -401,7 +399,7 @@ instance Integral Word where divMod (W# x#) y@(W# y#) | y /= 0 = (W# (x# `quotWord#` y#), W# (x# `remWord#` y#)) | otherwise = divZeroError - toInteger (W# x#) = wordToInteger x# + toInteger (W# x#) = integerFromWord# x# -------------------------------------------------------------- -- Instances for Integer @@ -413,19 +411,19 @@ instance Real Integer where -- | @since 4.8.0.0 instance Real Natural where - toRational n = naturalToInteger n :% 1 + toRational n = integerFromNatural n :% 1 -- Note [Integer division constant folding] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- --- Constant folding of quot, rem, div, mod, divMod and quotRem for --- Integer arguments depends crucially on inlining. Constant folding --- rules defined in GHC.Core.Opt.ConstantFold trigger for --- quotInteger, remInteger and so on. So if calls to quot, rem and so on --- were not inlined the rules would not fire. The rules would also not --- fire if calls to quotInteger and so on were inlined, but this does not --- happen because they are all marked with NOINLINE pragma - see documentation --- of integer-gmp or integer-simple. +-- Constant folding of quot, rem, div, mod, divMod and quotRem for Integer +-- arguments depends crucially on inlining. Constant folding rules defined in +-- GHC.Core.Opt.ConstantFold trigger for integerQuot, integerRem and so on. +-- So if calls to quot, rem and so on were not inlined the rules would not fire. +-- +-- The rules would also not fire if calls to integerQuot and so on were inlined, +-- but this does not happen because they are all marked with NOINLINE pragma. + -- | @since 2.0.1 instance Integral Integer where @@ -433,41 +431,55 @@ instance Integral Integer where {-# INLINE quot #-} _ `quot` 0 = divZeroError - n `quot` d = n `quotInteger` d + n `quot` d = n `integerQuot` d {-# INLINE rem #-} _ `rem` 0 = divZeroError - n `rem` d = n `remInteger` d + n `rem` d = n `integerRem` d {-# INLINE div #-} _ `div` 0 = divZeroError - n `div` d = n `divInteger` d + n `div` d = n `integerDiv` d {-# INLINE mod #-} _ `mod` 0 = divZeroError - n `mod` d = n `modInteger` d + n `mod` d = n `integerMod` d {-# INLINE divMod #-} _ `divMod` 0 = divZeroError - n `divMod` d = case n `divModInteger` d of - (# x, y #) -> (x, y) + n `divMod` d = n `integerDivMod` d {-# INLINE quotRem #-} _ `quotRem` 0 = divZeroError - n `quotRem` d = case n `quotRemInteger` d of - (# q, r #) -> (q, r) + n `quotRem` d = n `integerQuotRem` d -- | @since 4.8.0.0 instance Integral Natural where - toInteger = naturalToInteger + toInteger = integerFromNatural + + {-# INLINE quot #-} + _ `quot` 0 = divZeroError + n `quot` d = n `naturalQuot` d + + {-# INLINE rem #-} + _ `rem` 0 = divZeroError + n `rem` d = n `naturalRem` d + + {-# INLINE div #-} + _ `div` 0 = divZeroError + n `div` d = n `naturalQuot` d - divMod = quotRemNatural - div = quotNatural - mod = remNatural + {-# INLINE mod #-} + _ `mod` 0 = divZeroError + n `mod` d = n `naturalRem` d - quotRem = quotRemNatural - quot = quotNatural - rem = remNatural + {-# INLINE divMod #-} + _ `divMod` 0 = divZeroError + n `divMod` d = n `naturalQuotRem` d + + {-# INLINE quotRem #-} + _ `quotRem` 0 = divZeroError + n `quotRem` d = n `naturalQuotRem` d -------------------------------------------------------------- -- Instances for @Ratio@ @@ -574,8 +586,8 @@ fromIntegral = fromInteger . toInteger #-} {-# RULES -"fromIntegral/Word->Natural" fromIntegral = wordToNatural -"fromIntegral/Int->Natural" fromIntegral = intToNatural +"fromIntegral/Word->Natural" fromIntegral = naturalFromWord +"fromIntegral/Int->Natural" fromIntegral = naturalFromInt #-} -- | general coercion to fractional types @@ -766,28 +778,17 @@ lcm 0 _ = 0 lcm x y = abs ((x `quot` (gcd x y)) * y) {-# RULES -"gcd/Integer->Integer->Integer" gcd = gcdInteger -"lcm/Integer->Integer->Integer" lcm = lcmInteger -"gcd/Natural->Natural->Natural" gcd = gcdNatural -"lcm/Natural->Natural->Natural" lcm = lcmNatural +"gcd/Integer->Integer->Integer" gcd = integerGcd +"lcm/Integer->Integer->Integer" lcm = integerLcm +"gcd/Natural->Natural->Natural" gcd = naturalGcd +"lcm/Natural->Natural->Natural" lcm = naturalLcm #-} -#if defined(MIN_VERSION_integer_gmp) --- GMP defines a more efficient Int# and Word# GCD - -gcdInt' :: Int -> Int -> Int -gcdInt' (I# x) (I# y) = I# (gcdInt x y) - -gcdWord' :: Word -> Word -> Word -gcdWord' (W# x) (W# y) = W# (gcdWord x y) - {-# RULES -"gcd/Int->Int->Int" gcd = gcdInt' -"gcd/Word->Word->Word" gcd = gcdWord' +"gcd/Int->Int->Int" gcd = gcdInt +"gcd/Word->Word->Word" gcd = gcdWord #-} -#endif - integralEnumFrom :: (Integral a, Bounded a) => a -> [a] integralEnumFrom n = map fromInteger [toInteger n .. toInteger (maxBound `asTypeOf` n)] diff --git a/libraries/base/GHC/Show.hs b/libraries/base/GHC/Show.hs index 84077e473b..3de7aca723 100644 --- a/libraries/base/GHC/Show.hs +++ b/libraries/base/GHC/Show.hs @@ -470,6 +470,7 @@ itos n# cs -- | @since 2.01 instance Show Integer where + showsPrec p (IS i) r = showsPrec p (I# i) r showsPrec p n r | p > 6 && n < 0 = '(' : integerToString n (')' : r) -- Minor point: testing p first gives better code @@ -480,10 +481,8 @@ instance Show Integer where -- | @since 4.8.0.0 instance Show Natural where -#if defined(MIN_VERSION_integer_gmp) - showsPrec p (NatS# w#) = showsPrec p (W# w#) -#endif - showsPrec p i = showsPrec p (naturalToInteger i) + showsPrec p (NS w) = showsPrec p (W# w) + showsPrec p n = showsPrec p (integerFromNatural n) -- Divide and conquer implementation of string conversion integerToString :: Integer -> String -> String @@ -508,7 +507,7 @@ integerToString n0 cs0 jsplith :: Integer -> [Integer] -> [Integer] jsplith p (n:ns) = - case n `quotRemInteger` p of + case n `integerQuotRem#` p of (# q, r #) -> if q > 0 then q : r : jsplitb p ns else r : jsplitb p ns @@ -516,7 +515,7 @@ integerToString n0 cs0 jsplitb :: Integer -> [Integer] -> [Integer] jsplitb _ [] = [] - jsplitb p (n:ns) = case n `quotRemInteger` p of + jsplitb p (n:ns) = case n `integerQuotRem#` p of (# q, r #) -> q : r : jsplitb p ns @@ -525,7 +524,7 @@ integerToString n0 cs0 -- that all fit into a machine word. jprinth :: [Integer] -> String -> String jprinth (n:ns) cs = - case n `quotRemInteger` BASE of + case n `integerQuotRem#` BASE of (# q', r' #) -> let q = fromInteger q' r = fromInteger r' @@ -535,7 +534,7 @@ integerToString n0 cs0 jprintb :: [Integer] -> String -> String jprintb [] cs = cs - jprintb (n:ns) cs = case n `quotRemInteger` BASE of + jprintb (n:ns) cs = case n `integerQuotRem#` BASE of (# q', r' #) -> let q = fromInteger q' r = fromInteger r' diff --git a/libraries/base/GHC/Stack/Types.hs b/libraries/base/GHC/Stack/Types.hs index 1eee18b8f3..265b3c75b8 100644 --- a/libraries/base/GHC/Stack/Types.hs +++ b/libraries/base/GHC/Stack/Types.hs @@ -51,9 +51,8 @@ import GHC.Classes (Eq) import GHC.Types (Char, Int) -- Make implicit dependency known to build system -import GHC.Tuple () -- See Note [Depend on GHC.Tuple] in GHC.Base -import GHC.Integer () -- See Note [Depend on GHC.Integer] in GHC.Base -import GHC.Natural () -- See Note [Depend on GHC.Natural] in GHC.Base +import GHC.Tuple () -- See Note [Depend on GHC.Tuple] in GHC.Base +import GHC.Num.Integer () -- See Note [Depend on GHC.Num.Integer] in GHC.Base ---------------------------------------------------------------------- -- Explicit call-stacks built via ImplicitParams diff --git a/libraries/base/GHC/TypeNats.hs b/libraries/base/GHC/TypeNats.hs index aba47b0b96..5d06320fac 100644 --- a/libraries/base/GHC/TypeNats.hs +++ b/libraries/base/GHC/TypeNats.hs @@ -40,7 +40,7 @@ module GHC.TypeNats import GHC.Base(Eq(..), Ord(..), Bool(True), Ordering(..), otherwise) import GHC.Types( Nat ) -import GHC.Natural(Natural) +import GHC.Num.Natural(Natural) import GHC.Show(Show(..)) import GHC.Read(Read(..)) import GHC.Prim(magicDict, Proxy#) diff --git a/libraries/base/GHC/Word.hs b/libraries/base/GHC/Word.hs index 81415b8872..75ed7d1f73 100644 --- a/libraries/base/GHC/Word.hs +++ b/libraries/base/GHC/Word.hs @@ -112,7 +112,7 @@ instance Num Word8 where abs x = x signum 0 = 0 signum _ = 1 - fromInteger i = W8# (narrow8Word# (integerToWord i)) + fromInteger i = W8# (narrow8Word# (integerToWord# i)) -- | @since 2.01 instance Real Word8 where @@ -156,7 +156,7 @@ instance Integral Word8 where divMod (W8# x#) y@(W8# y#) | y /= 0 = (W8# (x# `quotWord#` y#), W8# (x# `remWord#` y#)) | otherwise = divZeroError - toInteger (W8# x#) = smallInteger (word2Int# x#) + toInteger (W8# x#) = IS (word2Int# x#) -- | @since 2.01 instance Bounded Word8 where @@ -303,7 +303,7 @@ instance Num Word16 where abs x = x signum 0 = 0 signum _ = 1 - fromInteger i = W16# (narrow16Word# (integerToWord i)) + fromInteger i = W16# (narrow16Word# (integerToWord# i)) -- | @since 2.01 instance Real Word16 where @@ -347,7 +347,7 @@ instance Integral Word16 where divMod (W16# x#) y@(W16# y#) | y /= 0 = (W16# (x# `quotWord#` y#), W16# (x# `remWord#` y#)) | otherwise = divZeroError - toInteger (W16# x#) = smallInteger (word2Int# x#) + toInteger (W16# x#) = IS (word2Int# x#) -- | @since 2.01 instance Bounded Word16 where @@ -533,7 +533,7 @@ instance Num Word32 where abs x = x signum 0 = 0 signum _ = 1 - fromInteger i = W32# (narrow32Word# (integerToWord i)) + fromInteger i = W32# (narrow32Word# (integerToWord# i)) -- | @since 2.01 instance Enum Word32 where @@ -589,12 +589,12 @@ instance Integral Word32 where | otherwise = divZeroError toInteger (W32# x#) #if WORD_SIZE_IN_BITS == 32 - | isTrue# (i# >=# 0#) = smallInteger i# - | otherwise = wordToInteger x# + | isTrue# (i# >=# 0#) = IS i# + | otherwise = integerFromWord# x# where !i# = word2Int# x# #else - = smallInteger (word2Int# x#) + = IS (word2Int# x#) #endif -- | @since 2.01 @@ -728,7 +728,7 @@ instance Num Word64 where abs x = x signum 0 = 0 signum _ = 1 - fromInteger i = W64# (integerToWord64 i) + fromInteger i = W64# (integerToWord64# i) -- | @since 2.01 instance Enum Word64 where @@ -770,7 +770,7 @@ instance Integral Word64 where divMod (W64# x#) y@(W64# y#) | y /= 0 = (W64# (x# `quotWord64#` y#), W64# (x# `remWord64#` y#)) | otherwise = divZeroError - toInteger (W64# x#) = word64ToInteger x# + toInteger (W64# x#) = integerFromWord64# x# -- | @since 2.01 instance Bits Word64 where @@ -875,7 +875,7 @@ instance Num Word64 where abs x = x signum 0 = 0 signum _ = 1 - fromInteger i = W64# (integerToWord i) + fromInteger i = W64# (integerToWord# i) -- | @since 2.01 instance Enum Word64 where @@ -954,8 +954,8 @@ instance Integral Word64 where | y /= 0 = (W64# (x# `quotWord#` y#), W64# (x# `remWord#` y#)) | otherwise = divZeroError toInteger (W64# x#) - | isTrue# (i# >=# 0#) = smallInteger i# - | otherwise = wordToInteger x# + | isTrue# (i# >=# 0#) = IS i# + | otherwise = integerFromWord# x# where !i# = word2Int# x# @@ -1088,11 +1088,11 @@ bitReverse64 (W64# w#) = W64# (bitReverse# w#) {-# RULES "fromIntegral/Word8->Natural" - fromIntegral = wordToNatural . (fromIntegral :: Word8 -> Word) + fromIntegral = naturalFromWord . (fromIntegral :: Word8 -> Word) "fromIntegral/Word16->Natural" - fromIntegral = wordToNatural . (fromIntegral :: Word16 -> Word) + fromIntegral = naturalFromWord . (fromIntegral :: Word16 -> Word) "fromIntegral/Word32->Natural" - fromIntegral = wordToNatural . (fromIntegral :: Word32 -> Word) + fromIntegral = naturalFromWord . (fromIntegral :: Word32 -> Word) #-} #if WORD_SIZE_IN_BITS == 64 @@ -1101,6 +1101,6 @@ bitReverse64 (W64# w#) = W64# (bitReverse# w#) "fromIntegral/Natural->Word64" fromIntegral = (fromIntegral :: Word -> Word64) . naturalToWord "fromIntegral/Word64->Natural" - fromIntegral = wordToNatural . (fromIntegral :: Word64 -> Word) + fromIntegral = naturalFromWord . (fromIntegral :: Word64 -> Word) #-} #endif |