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

-----------------------------------------------------------------------------
-- |
-- Module      :  Numeric
-- Copyright   :  (c) The University of Glasgow 2002
--
-- Stability   :  provisional
-- Portability :  portable
--
-- Odds and ends, mostly functions for reading and showing
-- 'RealFloat'-like kind of values.
--
-----------------------------------------------------------------------------

module Numeric (

-- * Showing

showSigned,

showIntAtBase,
showInt,
showHex,
showOct,

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

floatToDigits,

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

lexDigits,

-- * Miscellaneous

fromRat,
Floating(..)

) where

import GHC.Base
import GHC.Real
import GHC.Float
import GHC.Num
import GHC.Show

-- -----------------------------------------------------------------------------

-- | Reads an /unsigned/ 'Integral' value in an arbitrary base.
=> 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'
readInt :: a -> (Char -> Bool) -> (Char -> Int) -> ReadS a
base isDigit :: Char -> Bool
isDigit valDigit :: Char -> Int
readP_to_S (a -> (Char -> Bool) -> (Char -> Int) -> ReadP a
forall a. Num a => a -> (Char -> Bool) -> (Char -> Int) -> ReadP a
base Char -> Bool
isDigit Char -> Int
valDigit)

-- | Read an unsigned number in octal notation.
--
-- [(420,"")]
forall a. (Eq a, Num a) => ReadP a

-- | Read an unsigned number in decimal notation.
--
-- [(644,"")]
forall a. (Eq a, Num a) => ReadP a

-- Both upper or lower case letters are allowed.
--
-- [(3735928559,"")]
forall a. (Eq a, Num a) => ReadP a

-- | Reads an /unsigned/ 'RealFrac' value,
-- expressed in decimal scientific notation.
forall a. RealFrac a => ReadP a

do Lexeme
L.lex
case Lexeme
tok of
L.Number n :: Number
n -> a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m 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
pfail

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

-- | Reads a /signed/ 'Real' value, given a reader for an unsigned value.
r [(a, String)] -> [(a, String)] -> [(a, String)]
forall a. [a] -> [a] -> [a]
++
(do
("-",s :: String
lex String
r
(x :: a
x,t :: String
s
(a, String) -> [(a, String)]
forall (m :: * -> *) a. Monad m => a -> m a
return (-a
x,String
t))
r = do
(str :: String
str,s :: String
lex String
r
(n :: a
str
(a, String) -> [(a, String)]
forall (m :: * -> *) a. Monad m => a -> m a
return (a
n,String
s)

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

-- | Show /non-negative/ 'Integral' numbers in base 10.
showInt :: Integral a => a -> ShowS
showInt :: a -> ShowS
showInt n0 :: a
n0 cs0 :: String
cs0
| a
n0 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< 0    = ShowS
forall a. String -> a
errorWithoutStackTrace "Numeric.showInt: can't show negative numbers"
| Bool
otherwise = a -> ShowS
forall t. Integral t => t -> ShowS
go a
n0 String
cs0
where
go :: t -> ShowS
go n :: t
n cs :: String
cs
| t
n t -> t -> Bool
forall a. Ord a => a -> a -> Bool
< 10    = case Int -> Char
unsafeChr (Char -> Int
ord '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
cChar -> ShowS
forall a. a -> [a] -> [a]
:String
cs
| Bool
otherwise = case Int -> Char
unsafeChr (Char -> Int
ord '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# _) -> t -> ShowS
go t
q (Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:String
cs)
where
(q :: t
q,r :: t
r) = t
n t -> t -> (t, t)
forall a. Integral a => a -> a -> (a, a)
`quotRem` 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 :: Maybe Int -> a -> ShowS
showEFloat d :: Maybe Int
d x :: 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 :: Maybe Int -> a -> ShowS
showFFloat d :: Maybe Int
d x :: 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 :: Maybe Int -> a -> ShowS
showGFloat d :: Maybe Int
d x :: 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 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 4.7.0.0
showGFloatAlt    :: (RealFloat a) => Maybe Int -> a -> ShowS

showFFloatAlt :: Maybe Int -> a -> ShowS
showFFloatAlt d :: Maybe Int
d x :: 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 :: Maybe Int -> a -> ShowS
showGFloatAlt d :: Maybe Int
d x :: 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"
-}
showHFloat :: RealFloat a => a -> ShowS
showHFloat :: 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 x :: a
x
| a -> Bool
forall a. RealFloat a => a -> Bool
isNaN a
x                   = "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
< 0 then "-" else "") String -> ShowS
forall a. [a] -> [a] -> [a]
++ "Infinity"
| a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< 0 Bool -> Bool -> Bool
|| a -> Bool
forall a. RealFloat a => a -> Bool
isNegativeZero a
x = '-' 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 x :: a
x
| a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = "0x0p+0"
| Bool
otherwise =
case Integer -> a -> ([Int], Int)
forall a. RealFloat a => Integer -> a -> ([Int], Int)
floatToDigits 2 a
x of
r :: ([Int], Int)
r@([], _) -> ShowS
forall a. HasCallStack => String -> a
error ShowS -> ShowS
forall a b. (a -> b) -> a -> b
\$ "Impossible happened: showHFloat: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ([Int], Int) -> String
forall a. Show a => a -> String
show ([Int], Int)
r
(d :: Int
d:ds :: [Int]
ds, e :: Int
e) -> "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, Show a) => [a] -> String
frac [Int]
ds String -> ShowS
forall a. [a] -> [a] -> [a]
++ "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
-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 digits :: [a]
digits
| [a] -> Bool
forall a. (Eq a, Num a) => [a] -> Bool
allZ [a]
digits = ""
| Bool
otherwise   = "." String -> ShowS
forall a. [a] -> [a] -> [a]
++ [a] -> String
forall a. (Integral a, Show a) => [a] -> String
hex [a]
digits
where
hex :: [a] -> String
hex ds :: [a]
ds =
case [a]
ds of
[]                -> ""
[a :: a
a]               -> a -> a -> a -> a -> ShowS
forall a. (Integral a, Show a) => a -> a -> a -> a -> ShowS
hexDigit a
a 0 0 0 ""
[a :: a
a,b :: a
b]             -> a -> a -> a -> a -> ShowS
forall a. (Integral a, Show a) => a -> a -> a -> a -> ShowS
hexDigit a
a a
b 0 0 ""
[a :: a
a,b :: a
b,c :: a
c]           -> a -> a -> a -> a -> ShowS
forall a. (Integral a, Show a) => a -> a -> a -> a -> ShowS
hexDigit a
a a
b a
c 0 ""
a :: a
a : b :: a
b : c :: a
c : d :: a
d : r :: [a]
r -> a -> a -> a -> a -> ShowS
forall a. (Integral a, Show 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
b c :: a
c d :: a
d = a -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
showHex (8a -> a -> a
forall a. Num a => a -> a -> a
*a
a a -> a -> a
forall a. Num 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
+ 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 xs :: [a]
xs = case [a]
xs of
x :: a
x : more :: [a]
more -> a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== 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, Show a) => a -> (Int -> Char) -> a -> ShowS
showIntAtBase :: a -> (Int -> Char) -> a -> ShowS
showIntAtBase base :: a
base toChr :: Int -> Char
toChr n0 :: a
n0 r0 :: String
r0
| a
base a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= 1 = ShowS
forall a. String -> a
errorWithoutStackTrace ("Numeric.showIntAtBase: applied to unsupported base " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
base)
| a
n0 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<  0   = ShowS
forall a. String -> a
errorWithoutStackTrace ("Numeric.showIntAtBase: applied to negative number " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show 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 (n :: a
n,d :: a
d) r :: 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
0 -> String
r'
_ -> (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,Show a) => a -> ShowS
showHex :: a -> ShowS
showHex = a -> (Int -> Char) -> a -> ShowS
forall a. (Integral a, Show a) => a -> (Int -> Char) -> a -> ShowS
showIntAtBase 16 Int -> Char
intToDigit

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