{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE NoImplicitPrelude, MagicHash #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  GHC.Internal.Numeric
-- Copyright   :  (c) The University of Glasgow 2002
-- License     :  BSD-style (see the file libraries/base/LICENSE)
--
-- Maintainer  :  libraries@haskell.org
-- Stability   :  provisional
-- Portability :  portable
--
-- Odds and ends, mostly functions for reading and showing
-- 'RealFloat'-like kind of values.
--
-----------------------------------------------------------------------------

module GHC.Internal.Numeric (

        -- * Showing

        showSigned,

        showIntAtBase,
        showInt,
        showBin,
        showHex,
        showOct,

        showEFloat,
        showFFloat,
        showGFloat,
        showFFloatAlt,
        showGFloatAlt,
        showFloat,
        showHFloat,

        floatToDigits,

        -- * Reading

        -- | /NB:/ 'readInt' is the \'dual\' of 'showIntAtBase',
        -- and 'readDec' is the \`dual\' of 'showInt'.
        -- The inconsistent naming is a historical accident.

        readSigned,

        readInt,
        readBin,
        readDec,
        readOct,
        readHex,

        readFloat,

        lexDigits,

        -- * Miscellaneous

        fromRat,
        Floating(..)

        ) where

import GHC.Internal.Base
import GHC.Internal.Read
import GHC.Internal.Real
import GHC.Internal.Float
import GHC.Internal.Num
import GHC.Internal.Show
import GHC.Internal.Text.ParserCombinators.ReadP( ReadP, readP_to_S, pfail )
import qualified GHC.Internal.Text.Read.Lex as L

-- $setup
-- >>> import Prelude

-- -----------------------------------------------------------------------------
-- Reading

-- | Reads an /unsigned/ integral value in an arbitrary base.
readInt :: Num a
  => a                  -- ^ the base
  -> (Char -> Bool)     -- ^ a predicate distinguishing valid digits in this base
  -> (Char -> Int)      -- ^ a function converting a valid digit character to an 'Int'
  -> ReadS a
readInt :: forall a. Num a => a -> (Char -> Bool) -> (Char -> Int) -> ReadS a
readInt a
base Char -> Bool
isDigit Char -> Int
valDigit = ReadP a -> ReadS a
forall a. ReadP a -> ReadS a
readP_to_S (a -> (Char -> Bool) -> (Char -> Int) -> ReadP a
forall a. Num a => a -> (Char -> Bool) -> (Char -> Int) -> ReadP a
L.readIntP a
base Char -> Bool
isDigit Char -> Int
valDigit)

-- | Read an unsigned number in binary notation.
--
-- >>> readBin "10011"
-- [(19,"")]
readBin :: (Eq a, Num a) => ReadS a
readBin :: forall a. (Eq a, Num a) => ReadS a
readBin = ReadP a -> ReadS a
forall a. ReadP a -> ReadS a
readP_to_S ReadP a
forall a. (Eq a, Num a) => ReadP a
L.readBinP

-- | Read an unsigned number in octal notation.
--
-- >>> readOct "0644"
-- [(420,"")]
readOct :: (Eq a, Num a) => ReadS a
readOct :: forall a. (Eq a, Num a) => ReadS a
readOct = ReadP a -> ReadS a
forall a. ReadP a -> ReadS a
readP_to_S ReadP a
forall a. (Eq a, Num a) => ReadP a
L.readOctP

-- | Read an unsigned number in decimal notation.
--
-- >>> readDec "0644"
-- [(644,"")]
readDec :: (Eq a, Num a) => ReadS a
readDec :: forall a. (Eq a, Num a) => ReadS a
readDec = ReadP a -> ReadS a
forall a. ReadP a -> ReadS a
readP_to_S ReadP a
forall a. (Eq a, Num a) => ReadP a
L.readDecP

-- | Read an unsigned number in hexadecimal notation.
-- Both upper or lower case letters are allowed.
--
-- >>> readHex "deadbeef"
-- [(3735928559,"")]
readHex :: (Eq a, Num a) => ReadS a
readHex :: forall a. (Eq a, Num a) => ReadS a
readHex = ReadP a -> ReadS a
forall a. ReadP a -> ReadS a
readP_to_S ReadP a
forall a. (Eq a, Num a) => ReadP a
L.readHexP

-- | Reads an /unsigned/ 'RealFrac' value,
-- expressed in decimal scientific notation.
--
-- Note that this function takes time linear in the magnitude of its input
-- which can scale exponentially with input size (e.g. @"1e100000000"@ is a
-- very large number while having a very small textual form).
-- For this reason, users should take care to avoid using this function on
-- untrusted input. Users needing to parse floating point values
-- (e.g. 'Float') are encouraged to instead use 'read', which does
-- not suffer from this issue.
readFloat :: RealFrac a => ReadS a
readFloat :: forall a. RealFrac a => ReadS a
readFloat = ReadP a -> ReadS a
forall a. ReadP a -> ReadS a
readP_to_S ReadP a
forall a. RealFrac a => ReadP a
readFloatP

readFloatP :: RealFrac a => ReadP a
readFloatP :: forall a. RealFrac a => ReadP a
readFloatP =
  do tok <- ReadP Lexeme
L.lex
     case tok of
       L.Number Number
n -> a -> ReadP a
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> ReadP a) -> a -> ReadP a
forall a b. (a -> b) -> a -> b
$ Rational -> a
forall a. Fractional a => Rational -> a
fromRational (Rational -> a) -> Rational -> a
forall a b. (a -> b) -> a -> b
$ Number -> Rational
L.numberToRational Number
n
       Lexeme
_          -> ReadP a
forall a. ReadP a
pfail

-- It's turgid to have readSigned work using list comprehensions,
-- but it's specified as a ReadS to ReadS transformer
-- With a bit of luck no one will use it.

-- | Reads a /signed/ 'Real' value, given a reader for an unsigned value.
readSigned :: (Real a) => ReadS a -> ReadS a
readSigned :: forall a. Real a => ReadS a -> ReadS a
readSigned ReadS a
readPos = Bool -> ReadS a -> ReadS a
forall a. Bool -> ReadS a -> ReadS a
readParen Bool
False ReadS a
read'
                     where read' :: ReadS a
read' String
r  = ReadS a
read'' String
r [(a, String)] -> [(a, String)] -> [(a, String)]
forall a. [a] -> [a] -> [a]
++
                                      (do
                                        ("-",s) <- ReadS String
lex String
r
                                        (x,t)   <- read'' s
                                        return (-x,t))
                           read'' :: ReadS a
read'' String
r = do
                               (str,s) <- ReadS String
lex String
r
                               (n,"")  <- readPos str
                               return (n,s)

-- -----------------------------------------------------------------------------
-- Showing

-- | Show /non-negative/ 'Integral' numbers in base 10.
showInt :: Integral a => a -> ShowS
showInt :: forall a. Integral a => a -> ShowS
showInt a
n0 String
cs0
    | a
n0 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0    = ShowS
forall a. String -> a
errorWithoutStackTrace String
"GHC.Internal.Numeric.showInt: can't show negative numbers"
    | Bool
otherwise = a -> ShowS
forall a. Integral a => a -> ShowS
go a
n0 String
cs0
    where
    go :: t -> ShowS
go t
n String
cs
        | t
n t -> t -> Bool
forall a. Ord a => a -> a -> Bool
< t
10    = case Int -> Char
unsafeChr (Char -> Int
ord Char
'0' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ t -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral t
n) of
            c :: Char
c@(C# Char#
_) -> Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:String
cs
        | Bool
otherwise = case Int -> Char
unsafeChr (Char -> Int
ord Char
'0' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ t -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral t
r) of
            c :: Char
c@(C# Char#
_) -> t -> ShowS
go t
q (Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:String
cs)
        where
        (t
q,t
r) = t
n t -> t -> (t, t)
forall a. Integral a => a -> a -> (a, a)
`quotRem` t
10

-- Controlling the format and precision of floats. The code that
-- implements the formatting itself is in @PrelNum@ to avoid
-- mutual module deps.

{-# SPECIALIZE showEFloat ::
        Maybe Int -> Float  -> ShowS,
        Maybe Int -> Double -> ShowS #-}
{-# SPECIALIZE showFFloat ::
        Maybe Int -> Float  -> ShowS,
        Maybe Int -> Double -> ShowS #-}
{-# SPECIALIZE showGFloat ::
        Maybe Int -> Float  -> ShowS,
        Maybe Int -> Double -> ShowS #-}

-- | Show a signed 'RealFloat' value
-- using scientific (exponential) notation (e.g. @2.45e2@, @1.5e-3@).
--
-- In the call @'showEFloat' digs val@, if @digs@ is 'Nothing',
-- the value is shown to full precision; if @digs@ is @'Just' d@,
-- then at most @d@ digits after the decimal point are shown.
showEFloat    :: (RealFloat a) => Maybe Int -> a -> ShowS

-- | Show a signed 'RealFloat' value
-- using standard decimal notation (e.g. @245000@, @0.0015@).
--
-- In the call @'showFFloat' digs val@, if @digs@ is 'Nothing',
-- the value is shown to full precision; if @digs@ is @'Just' d@,
-- then at most @d@ digits after the decimal point are shown.
showFFloat    :: (RealFloat a) => Maybe Int -> a -> ShowS

-- | Show a signed 'RealFloat' value
-- using standard decimal notation for arguments whose absolute value lies
-- between @0.1@ and @9,999,999@, and scientific notation otherwise.
--
-- In the call @'showGFloat' digs val@, if @digs@ is 'Nothing',
-- the value is shown to full precision; if @digs@ is @'Just' d@,
-- then at most @d@ digits after the decimal point are shown.
showGFloat    :: (RealFloat a) => Maybe Int -> a -> ShowS

showEFloat :: forall a. RealFloat a => Maybe Int -> a -> ShowS
showEFloat Maybe Int
d a
x =  String -> ShowS
showString (FFFormat -> Maybe Int -> a -> String
forall a. RealFloat a => FFFormat -> Maybe Int -> a -> String
formatRealFloat FFFormat
FFExponent Maybe Int
d a
x)
showFFloat :: forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
d a
x =  String -> ShowS
showString (FFFormat -> Maybe Int -> a -> String
forall a. RealFloat a => FFFormat -> Maybe Int -> a -> String
formatRealFloat FFFormat
FFFixed Maybe Int
d a
x)
showGFloat :: forall a. RealFloat a => Maybe Int -> a -> ShowS
showGFloat Maybe Int
d a
x =  String -> ShowS
showString (FFFormat -> Maybe Int -> a -> String
forall a. RealFloat a => FFFormat -> Maybe Int -> a -> String
formatRealFloat FFFormat
FFGeneric Maybe Int
d a
x)

-- | Show a signed 'RealFloat' value
-- using standard decimal notation (e.g. @245000@, @0.0015@).
--
-- This behaves as 'showFFloat', except that a decimal point
-- is always guaranteed, even if not needed.
--
-- @since base-4.7.0.0
showFFloatAlt    :: (RealFloat a) => Maybe Int -> a -> ShowS

-- | Show a signed 'RealFloat' value
-- using standard decimal notation for arguments whose absolute value lies
-- between @0.1@ and @9,999,999@, and scientific notation otherwise.
--
-- This behaves as 'showFFloat', except that a decimal point
-- is always guaranteed, even if not needed.
--
-- @since base-4.7.0.0
showGFloatAlt    :: (RealFloat a) => Maybe Int -> a -> ShowS

showFFloatAlt :: forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloatAlt Maybe Int
d a
x =  String -> ShowS
showString (FFFormat -> Maybe Int -> Bool -> a -> String
forall a.
RealFloat a =>
FFFormat -> Maybe Int -> Bool -> a -> String
formatRealFloatAlt FFFormat
FFFixed Maybe Int
d Bool
True a
x)
showGFloatAlt :: forall a. RealFloat a => Maybe Int -> a -> ShowS
showGFloatAlt Maybe Int
d a
x =  String -> ShowS
showString (FFFormat -> Maybe Int -> Bool -> a -> String
forall a.
RealFloat a =>
FFFormat -> Maybe Int -> Bool -> a -> String
formatRealFloatAlt FFFormat
FFGeneric Maybe Int
d Bool
True a
x)

{- | Show a floating-point value in the hexadecimal format,
similar to the @%a@ specifier in C's printf.

  >>> showHFloat (212.21 :: Double) ""
  "0x1.a86b851eb851fp7"
  >>> showHFloat (-12.76 :: Float) ""
  "-0x1.9851ecp3"
  >>> showHFloat (-0 :: Double) ""
  "-0x0p+0"

@since base-4.11.0.0
-}
showHFloat :: RealFloat a => a -> ShowS
showHFloat :: forall a. RealFloat a => a -> ShowS
showHFloat = String -> ShowS
showString (String -> ShowS) -> (a -> String) -> a -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall {a}. RealFloat a => a -> String
fmt
  where
  fmt :: a -> String
fmt a
x
    | a -> Bool
forall a. RealFloat a => a -> Bool
isNaN a
x                   = String
"NaN"
    | a -> Bool
forall a. RealFloat a => a -> Bool
isInfinite a
x              = (if a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 then String
"-" else String
"") String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Infinity"
    | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 Bool -> Bool -> Bool
|| a -> Bool
forall a. RealFloat a => a -> Bool
isNegativeZero a
x = Char
'-' Char -> ShowS
forall a. a -> [a] -> [a]
: a -> String
forall {a}. RealFloat a => a -> String
cvt (-a
x)
    | Bool
otherwise                 = a -> String
forall {a}. RealFloat a => a -> String
cvt a
x

  cvt :: a -> String
cvt a
x
    | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 = String
"0x0p+0"
    | Bool
otherwise =
      case Integer -> a -> ([Int], Int)
forall a. RealFloat a => Integer -> a -> ([Int], Int)
floatToDigits Integer
2 a
x of
        r :: ([Int], Int)
r@([], Int
_) -> ShowS
forall a. HasCallStack => String -> a
error ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
"Impossible happened: showHFloat: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ([Int], Int) -> String
forall a. Show a => a -> String
show ([Int], Int)
r
        (Int
d:[Int]
ds, Int
e) -> String
"0x" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
d String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Int] -> String
forall {a}. Integral a => [a] -> String
frac [Int]
ds String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"p" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Int
eInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)

  -- Given binary digits, convert them to hex in blocks of 4
  -- Special case: If all 0's, just drop it.
  frac :: [a] -> String
frac [a]
digits
    | [a] -> Bool
forall {a}. (Eq a, Num a) => [a] -> Bool
allZ [a]
digits = String
""
    | Bool
otherwise   = String
"." String -> ShowS
forall a. [a] -> [a] -> [a]
++ [a] -> String
forall {a}. Integral a => [a] -> String
hex [a]
digits
    where
    hex :: [a] -> String
hex [a]
ds =
      case [a]
ds of
        []                -> String
""
        [a
a]               -> a -> a -> a -> a -> ShowS
forall {a}. Integral a => a -> a -> a -> a -> ShowS
hexDigit a
a a
0 a
0 a
0 String
""
        [a
a,a
b]             -> a -> a -> a -> a -> ShowS
forall {a}. Integral a => a -> a -> a -> a -> ShowS
hexDigit a
a a
b a
0 a
0 String
""
        [a
a,a
b,a
c]           -> a -> a -> a -> a -> ShowS
forall {a}. Integral a => a -> a -> a -> a -> ShowS
hexDigit a
a a
b a
c a
0 String
""
        a
a : a
b : a
c : a
d : [a]
r -> a -> a -> a -> a -> ShowS
forall {a}. Integral a => a -> a -> a -> a -> ShowS
hexDigit a
a a
b a
c a
d ([a] -> String
hex [a]
r)

  hexDigit :: a -> a -> a -> a -> ShowS
hexDigit a
a a
b a
c a
d = a -> ShowS
forall a. Integral a => a -> ShowS
showHex (a
8a -> a -> a
forall a. Num a => a -> a -> a
*a
a a -> a -> a
forall a. Num a => a -> a -> a
+ a
4a -> a -> a
forall a. Num a => a -> a -> a
*a
b a -> a -> a
forall a. Num a => a -> a -> a
+ a
2a -> a -> a
forall a. Num a => a -> a -> a
*a
c a -> a -> a
forall a. Num a => a -> a -> a
+ a
d)

  allZ :: [a] -> Bool
allZ [a]
xs = case [a]
xs of
              a
x : [a]
more -> a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 Bool -> Bool -> Bool
&& [a] -> Bool
allZ [a]
more
              []       -> Bool
True

-- ---------------------------------------------------------------------------
-- Integer printing functions

-- | Shows a /non-negative/ 'Integral' number using the base specified by the
-- first argument, and the character representation specified by the second.
showIntAtBase :: Integral a => a -> (Int -> Char) -> a -> ShowS
showIntAtBase :: forall a. Integral a => a -> (Int -> Char) -> a -> ShowS
showIntAtBase a
base Int -> Char
toChr a
n0 String
r0
  | a
base a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
1 = ShowS
forall a. String -> a
errorWithoutStackTrace (String
"GHC.Internal.Numeric.showIntAtBase: applied to unsupported base " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show (a -> Integer
forall a. Integral a => a -> Integer
toInteger a
base))
  | a
n0 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<  a
0   = ShowS
forall a. String -> a
errorWithoutStackTrace (String
"GHC.Internal.Numeric.showIntAtBase: applied to negative number " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show (a -> Integer
forall a. Integral a => a -> Integer
toInteger a
n0))
  | Bool
otherwise = (a, a) -> ShowS
showIt (a -> a -> (a, a)
forall a. Integral a => a -> a -> (a, a)
quotRem a
n0 a
base) String
r0
   where
    showIt :: (a, a) -> ShowS
showIt (a
n,a
d) String
r = Char -> ShowS
forall a b. a -> b -> b
seq Char
c ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ -- stricter than necessary
      case a
n of
        a
0 -> String
r'
        a
_ -> (a, a) -> ShowS
showIt (a -> a -> (a, a)
forall a. Integral a => a -> a -> (a, a)
quotRem a
n a
base) String
r'
     where
      c :: Char
c  = Int -> Char
toChr (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
d)
      r' :: String
r' = Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: String
r

-- | Show /non-negative/ 'Integral' numbers in base 16.
showHex :: Integral a => a -> ShowS
showHex :: forall a. Integral a => a -> ShowS
showHex = a -> (Int -> Char) -> a -> ShowS
forall a. Integral a => a -> (Int -> Char) -> a -> ShowS
showIntAtBase a
16 Int -> Char
intToDigit

-- | Show /non-negative/ 'Integral' numbers in base 8.
showOct :: Integral a => a -> ShowS
showOct :: forall a. Integral a => a -> ShowS
showOct = a -> (Int -> Char) -> a -> ShowS
forall a. Integral a => a -> (Int -> Char) -> a -> ShowS
showIntAtBase a
8  Int -> Char
intToDigit

-- | Show /non-negative/ 'Integral' numbers in base 2.
showBin :: Integral a => a -> ShowS
showBin :: forall a. Integral a => a -> ShowS
showBin = a -> (Int -> Char) -> a -> ShowS
forall a. Integral a => a -> (Int -> Char) -> a -> ShowS
showIntAtBase a
2  Int -> Char
intToDigit