{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE NoImplicitPrelude, MagicHash #-}
module Numeric (
showSigned,
showIntAtBase,
showInt,
showBin,
showHex,
showOct,
showEFloat,
showFFloat,
showGFloat,
showFFloatAlt,
showGFloatAlt,
showFloat,
showHFloat,
floatToDigits,
readSigned,
readInt,
readBin,
readDec,
readOct,
readHex,
readFloat,
lexDigits,
fromRat,
Floating(..)
) where
import GHC.Base
import GHC.Read
import GHC.Real
import GHC.Float
import GHC.Num
import GHC.Show
import Text.ParserCombinators.ReadP( ReadP, readP_to_S, pfail )
import qualified Text.Read.Lex as L
readInt :: Num a
=> a
-> (Char -> Bool)
-> (Char -> 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)
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
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
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
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
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 Lexeme
tok <- ReadP Lexeme
L.lex
case Lexeme
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
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
(String
"-",String
s) <- ReadS String
lex String
r
(a
x,String
t) <- ReadS a
read'' String
s
(a, String) -> [(a, String)]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (-a
x,String
t))
read'' :: ReadS a
read'' String
r = do
(String
str,String
s) <- ReadS String
lex String
r
(a
n,String
"") <- ReadS a
readPos String
str
(a, String) -> [(a, String)]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (a
n,String
s)
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
"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
{-# 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 #-}
showEFloat :: (RealFloat a) => Maybe Int -> a -> ShowS
showFFloat :: (RealFloat a) => Maybe Int -> a -> ShowS
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)
showFFloatAlt :: (RealFloat a) => Maybe Int -> a -> ShowS
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)
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)
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
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
"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
"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
$
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
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
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
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