Commit 0f67e344 authored by Sylvain Henry's avatar Sylvain Henry Committed by Ben Gamari

Update `base` package

* GHC.Natural isn't implemented in `base` anymore. It is provided by
  ghc-bignum in GHC.Num.Natural. It means that we can safely use Natural
  primitives in `base` without fearing issues with built-in rewrite
  rules (cf #15286)

* `base` doesn't conditionally depend on an integer-* package anymore,
  it depends on ghc-bignum

* Some duplicated code in integer-* can now be factored in GHC.Float

* ghc-bignum tries to use a uniform naming convention so most of the
  other changes are renaming
parent 96aa5787
......@@ -533,17 +533,19 @@ instance FiniteBits Word where
-- | @since 2.01
instance Bits Integer where
(.&.) = andInteger
(.|.) = orInteger
xor = xorInteger
complement = complementInteger
shift x i@(I# i#) | i >= 0 = shiftLInteger x i#
| otherwise = shiftRInteger x (negateInt# i#)
testBit x (I# i) = testBitInteger x i
zeroBits = 0
bit (I# i#) = bitInteger i#
popCount x = I# (popCountInteger x)
(.&.) = integerAnd
(.|.) = integerOr
xor = integerXor
complement = integerComplement
shiftR x i = integerShiftR x (fromIntegral i)
shiftL x i = integerShiftL x (fromIntegral i)
shift x i | i >= 0 = integerShiftL x (fromIntegral i)
| otherwise = integerShiftR x (fromIntegral (negate i))
testBit x i = integerTestBit x (fromIntegral i)
zeroBits = integerZero
bit (I# i) = integerBit# (int2Word# i)
popCount x = I# (integerPopCount# x)
rotate x i = shift x i -- since an Integer never wraps around
......@@ -553,20 +555,22 @@ instance Bits Integer where
-- | @since 4.8.0
instance Bits Natural where
(.&.) = andNatural
(.|.) = orNatural
xor = xorNatural
complement _ = errorWithoutStackTrace
(.&.) = naturalAnd
(.|.) = naturalOr
xor = naturalXor
complement _ = errorWithoutStackTrace
"Bits.complement: Natural complement undefined"
shiftR x i = naturalShiftR x (fromIntegral i)
shiftL x i = naturalShiftL x (fromIntegral i)
shift x i
| i >= 0 = shiftLNatural x i
| otherwise = shiftRNatural x (negate i)
testBit x i = testBitNatural x i
zeroBits = wordToNaturalBase 0##
| i >= 0 = naturalShiftL x (fromIntegral i)
| otherwise = naturalShiftR x (fromIntegral (negate i))
testBit x i = naturalTestBit x (fromIntegral i)
zeroBits = naturalZero
clearBit x i = x `xor` (bit i .&. x)
bit (I# i#) = bitNatural i#
popCount x = popCountNatural x
bit (I# i) = naturalBit# (int2Word# i)
popCount x = I# (word2Int# (naturalPopCount# x))
rotate x i = shift x i -- since an Natural never wraps around
......
......@@ -4,7 +4,7 @@ module Data.Semigroup.Internal where
import {-# SOURCE #-} GHC.Real (Integral)
import {-# SOURCE #-} GHC.Base (Semigroup,Monoid,Maybe)
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
stimesIdempotentMonoid :: (Integral b, Monoid a) => b -> a -> a
......
......@@ -24,7 +24,6 @@ module Data.Unique (
import System.IO.Unsafe (unsafePerformIO)
import GHC.Base
import GHC.Num
import Data.IORef
......@@ -77,4 +76,4 @@ newUnique = do
-- same value, although in practice this is unlikely. The 'Int'
-- returned makes a good hash key.
hashUnique :: Unique -> Int
hashUnique (Unique i) = I# (hashInteger i)
hashUnique (Unique i) = integerToInt i
......@@ -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
......
......@@ -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
......
......@@ -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 )
......
......@@ -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
------------------------------------------------------------------------
......
......@@ -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 #-}
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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))