{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE Trustworthy #-}
#if __GLASGOW_HASKELL__ >= 800
{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE StandaloneDeriving #-}
#else
{-# LANGUAGE TemplateHaskell #-}
#endif
module Data.Scientific
( Scientific
, scientific
, coefficient
, base10Exponent
, isFloating
, isInteger
, unsafeFromRational
, fromRationalRepetend
, fromRationalRepetendLimited
, fromRationalRepetendUnlimited
, toRationalRepetend
, floatingOrInteger
, toRealFloat
, toBoundedRealFloat
, toBoundedInteger
, fromFloatDigits
, scientificP
, formatScientific
, FPFormat(..)
, toDecimalDigits
, normalize
) where
import Control.Exception (throw, ArithException(DivideByZero))
import Control.Monad (mplus)
import Control.DeepSeq (NFData, rnf)
import Data.Binary (Binary, get, put)
import Data.Char (intToDigit, ord)
import Data.Data (Data)
import Data.Hashable (Hashable(..))
import Data.Int (Int8, Int16, Int32, Int64)
import qualified Data.Map as M (Map, empty, insert, lookup)
import Data.Ratio ((%), numerator, denominator)
import Data.Typeable (Typeable)
import Data.Word (Word8, Word16, Word32, Word64)
import Math.NumberTheory.Logarithms (integerLog10')
import qualified Numeric (floatToDigits)
import qualified Text.Read as Read
import Text.Read (readPrec)
import qualified Text.ParserCombinators.ReadPrec as ReadPrec
import qualified Text.ParserCombinators.ReadP as ReadP
import Text.ParserCombinators.ReadP ( ReadP )
import Data.Text.Lazy.Builder.RealFloat (FPFormat(..))
#if !MIN_VERSION_base(4,9,0)
import Control.Applicative ((*>))
#endif
#if !MIN_VERSION_base(4,8,0)
import Data.Functor ((<$>))
import Data.Word (Word)
import Control.Applicative ((<*>))
#endif
import GHC.Integer.Compat (quotRemInteger, quotInteger, divInteger)
import Utils (maxExpt, roundTo, magnitude)
import Language.Haskell.TH.Syntax (Lift (..))
data Scientific = Scientific
{ Scientific -> Integer
coefficient :: !Integer
, Scientific -> Int
base10Exponent :: {-# UNPACK #-} !Int
} deriving (Typeable, Typeable Scientific
Scientific -> DataType
Scientific -> Constr
(forall b. Data b => b -> b) -> Scientific -> Scientific
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Scientific -> u
forall u. (forall d. Data d => d -> u) -> Scientific -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Scientific -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Scientific -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Scientific -> m Scientific
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Scientific -> m Scientific
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Scientific
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Scientific -> c Scientific
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Scientific)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Scientific)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Scientific -> m Scientific
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Scientific -> m Scientific
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Scientific -> m Scientific
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Scientific -> m Scientific
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Scientific -> m Scientific
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Scientific -> m Scientific
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Scientific -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Scientific -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Scientific -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Scientific -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Scientific -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Scientific -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Scientific -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Scientific -> r
gmapT :: (forall b. Data b => b -> b) -> Scientific -> Scientific
$cgmapT :: (forall b. Data b => b -> b) -> Scientific -> Scientific
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Scientific)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Scientific)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Scientific)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Scientific)
dataTypeOf :: Scientific -> DataType
$cdataTypeOf :: Scientific -> DataType
toConstr :: Scientific -> Constr
$ctoConstr :: Scientific -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Scientific
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Scientific
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Scientific -> c Scientific
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Scientific -> c Scientific
Data)
scientific :: Integer -> Int -> Scientific
scientific :: Integer -> Int -> Scientific
scientific = Integer -> Int -> Scientific
Scientific
#if __GLASGOW_HASKELL__ >= 800
deriving instance Lift Scientific
#else
instance Lift Scientific where
lift (Scientific c e) = [| Scientific c e |]
#endif
instance NFData Scientific where
rnf :: Scientific -> ()
rnf (Scientific Integer
_ Int
_) = ()
instance Hashable Scientific where
hashWithSalt :: Int -> Scientific -> Int
hashWithSalt Int
salt Scientific
s = Int
salt forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Integer
c forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Int
e
where
Scientific Integer
c Int
e = Scientific -> Scientific
normalize Scientific
s
instance Binary Scientific where
put :: Scientific -> Put
put (Scientific Integer
c Int
e) = forall t. Binary t => t -> Put
put Integer
c forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall t. Binary t => t -> Put
put (forall a. Integral a => a -> Integer
toInteger Int
e)
get :: Get Scientific
get = Integer -> Int -> Scientific
Scientific forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Num a => Integer -> a
fromInteger forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get)
instance Eq Scientific where
Scientific
s1 == :: Scientific -> Scientific -> Bool
== Scientific
s2 = Integer
c1 forall a. Eq a => a -> a -> Bool
== Integer
c2 Bool -> Bool -> Bool
&& Int
e1 forall a. Eq a => a -> a -> Bool
== Int
e2
where
Scientific Integer
c1 Int
e1 = Scientific -> Scientific
normalize Scientific
s1
Scientific Integer
c2 Int
e2 = Scientific -> Scientific
normalize Scientific
s2
instance Ord Scientific where
compare :: Scientific -> Scientific -> Ordering
compare Scientific
s1 Scientific
s2
| Integer
c1 forall a. Eq a => a -> a -> Bool
== Integer
c2 Bool -> Bool -> Bool
&& Int
e1 forall a. Eq a => a -> a -> Bool
== Int
e2 = Ordering
EQ
| Integer
c1 forall a. Ord a => a -> a -> Bool
< Integer
0 = if Integer
c2 forall a. Ord a => a -> a -> Bool
< Integer
0 then Integer -> Int -> Integer -> Int -> Ordering
cmp (-Integer
c2) Int
e2 (-Integer
c1) Int
e1 else Ordering
LT
| Integer
c1 forall a. Ord a => a -> a -> Bool
> Integer
0 = if Integer
c2 forall a. Ord a => a -> a -> Bool
> Integer
0 then Integer -> Int -> Integer -> Int -> Ordering
cmp Integer
c1 Int
e1 Integer
c2 Int
e2 else Ordering
GT
| Bool
otherwise = if Integer
c2 forall a. Ord a => a -> a -> Bool
> Integer
0 then Ordering
LT else Ordering
GT
where
Scientific Integer
c1 Int
e1 = Scientific -> Scientific
normalize Scientific
s1
Scientific Integer
c2 Int
e2 = Scientific -> Scientific
normalize Scientific
s2
cmp :: Integer -> Int -> Integer -> Int -> Ordering
cmp Integer
cx Int
ex Integer
cy Int
ey
| Int
log10sx forall a. Ord a => a -> a -> Bool
< Int
log10sy = Ordering
LT
| Int
log10sx forall a. Ord a => a -> a -> Bool
> Int
log10sy = Ordering
GT
| Int
d forall a. Ord a => a -> a -> Bool
< Int
0 = if Integer
cx forall a. Ord a => a -> a -> Bool
<= (Integer
cy Integer -> Integer -> Integer
`quotInteger` forall a. Num a => Int -> a
magnitude (-Int
d)) then Ordering
LT else Ordering
GT
| Int
d forall a. Ord a => a -> a -> Bool
> Int
0 = if Integer
cy forall a. Ord a => a -> a -> Bool
> (Integer
cx Integer -> Integer -> Integer
`quotInteger` forall a. Num a => Int -> a
magnitude Int
d) then Ordering
LT else Ordering
GT
| Bool
otherwise = if Integer
cx forall a. Ord a => a -> a -> Bool
< Integer
cy then Ordering
LT else Ordering
GT
where
log10sx :: Int
log10sx = Int
log10cx forall a. Num a => a -> a -> a
+ Int
ex
log10sy :: Int
log10sy = Int
log10cy forall a. Num a => a -> a -> a
+ Int
ey
log10cx :: Int
log10cx = Integer -> Int
integerLog10' Integer
cx
log10cy :: Int
log10cy = Integer -> Int
integerLog10' Integer
cy
d :: Int
d = Int
log10cx forall a. Num a => a -> a -> a
- Int
log10cy
instance Num Scientific where
Scientific Integer
c1 Int
e1 + :: Scientific -> Scientific -> Scientific
+ Scientific Integer
c2 Int
e2
| Int
e1 forall a. Ord a => a -> a -> Bool
< Int
e2 = Integer -> Int -> Scientific
Scientific (Integer
c1 forall a. Num a => a -> a -> a
+ Integer
c2forall a. Num a => a -> a -> a
*Integer
l) Int
e1
| Bool
otherwise = Integer -> Int -> Scientific
Scientific (Integer
c1forall a. Num a => a -> a -> a
*Integer
r forall a. Num a => a -> a -> a
+ Integer
c2 ) Int
e2
where
l :: Integer
l = forall a. Num a => Int -> a
magnitude (Int
e2 forall a. Num a => a -> a -> a
- Int
e1)
r :: Integer
r = forall a. Num a => Int -> a
magnitude (Int
e1 forall a. Num a => a -> a -> a
- Int
e2)
{-# INLINABLE (+) #-}
Scientific Integer
c1 Int
e1 - :: Scientific -> Scientific -> Scientific
- Scientific Integer
c2 Int
e2
| Int
e1 forall a. Ord a => a -> a -> Bool
< Int
e2 = Integer -> Int -> Scientific
Scientific (Integer
c1 forall a. Num a => a -> a -> a
- Integer
c2forall a. Num a => a -> a -> a
*Integer
l) Int
e1
| Bool
otherwise = Integer -> Int -> Scientific
Scientific (Integer
c1forall a. Num a => a -> a -> a
*Integer
r forall a. Num a => a -> a -> a
- Integer
c2 ) Int
e2
where
l :: Integer
l = forall a. Num a => Int -> a
magnitude (Int
e2 forall a. Num a => a -> a -> a
- Int
e1)
r :: Integer
r = forall a. Num a => Int -> a
magnitude (Int
e1 forall a. Num a => a -> a -> a
- Int
e2)
{-# INLINABLE (-) #-}
Scientific Integer
c1 Int
e1 * :: Scientific -> Scientific -> Scientific
* Scientific Integer
c2 Int
e2 =
Integer -> Int -> Scientific
Scientific (Integer
c1 forall a. Num a => a -> a -> a
* Integer
c2) (Int
e1 forall a. Num a => a -> a -> a
+ Int
e2)
{-# INLINABLE (*) #-}
abs :: Scientific -> Scientific
abs (Scientific Integer
c Int
e) = Integer -> Int -> Scientific
Scientific (forall a. Num a => a -> a
abs Integer
c) Int
e
{-# INLINABLE abs #-}
negate :: Scientific -> Scientific
negate (Scientific Integer
c Int
e) = Integer -> Int -> Scientific
Scientific (forall a. Num a => a -> a
negate Integer
c) Int
e
{-# INLINABLE negate #-}
signum :: Scientific -> Scientific
signum (Scientific Integer
c Int
_) = Integer -> Int -> Scientific
Scientific (forall a. Num a => a -> a
signum Integer
c) Int
0
{-# INLINABLE signum #-}
fromInteger :: Integer -> Scientific
fromInteger Integer
i = Integer -> Int -> Scientific
Scientific Integer
i Int
0
{-# INLINABLE fromInteger #-}
instance Real Scientific where
toRational :: Scientific -> Rational
toRational (Scientific Integer
c Int
e)
| Int
e forall a. Ord a => a -> a -> Bool
< Int
0 = Integer
c forall a. Integral a => a -> a -> Ratio a
% forall a. Num a => Int -> a
magnitude (-Int
e)
| Bool
otherwise = (Integer
c forall a. Num a => a -> a -> a
* forall a. Num a => Int -> a
magnitude Int
e) forall a. Integral a => a -> a -> Ratio a
% Integer
1
{-# INLINABLE toRational #-}
{-# RULES
"realToFrac_toRealFloat_Double"
realToFrac = toRealFloat :: Scientific -> Double #-}
{-# RULES
"realToFrac_toRealFloat_Float"
realToFrac = toRealFloat :: Scientific -> Float #-}
instance Fractional Scientific where
recip :: Scientific -> Scientific
recip = forall a. Fractional a => Rational -> a
fromRational forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Fractional a => a -> a
recip forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Real a => a -> Rational
toRational
Scientific Integer
c1 Int
e1 / :: Scientific -> Scientific -> Scientific
/ Scientific Integer
c2 Int
e2
| Int
d forall a. Ord a => a -> a -> Bool
< Int
0 = forall a. Fractional a => Rational -> a
fromRational (Rational
x forall a. Fractional a => a -> a -> a
/ (forall a. Num a => Integer -> a
fromInteger (forall a. Num a => Int -> a
magnitude (-Int
d))))
| Bool
otherwise = forall a. Fractional a => Rational -> a
fromRational (Rational
x forall a. Num a => a -> a -> a
* forall a. Num a => Integer -> a
fromInteger (forall a. Num a => Int -> a
magnitude Int
d))
where
d :: Int
d = Int
e1 forall a. Num a => a -> a -> a
- Int
e2
x :: Rational
x = Integer
c1 forall a. Integral a => a -> a -> Ratio a
% Integer
c2
fromRational :: Rational -> Scientific
fromRational Rational
rational =
case Maybe Int
mbRepetendIx of
Maybe Int
Nothing -> Scientific
s
Just Int
_ix -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$
[Char]
"fromRational has been applied to a repeating decimal " forall a. [a] -> [a] -> [a]
++
[Char]
"which can't be represented as a Scientific! " forall a. [a] -> [a] -> [a]
++
[Char]
"It's better to avoid performing fractional operations on Scientifics " forall a. [a] -> [a] -> [a]
++
[Char]
"and convert them to other fractional types like Double as early as possible."
where
(Scientific
s, Maybe Int
mbRepetendIx) = Rational -> (Scientific, Maybe Int)
fromRationalRepetendUnlimited Rational
rational
unsafeFromRational :: Rational -> Scientific
unsafeFromRational :: Rational -> Scientific
unsafeFromRational Rational
rational
| Integer
d forall a. Eq a => a -> a -> Bool
== Integer
0 = forall a e. Exception e => e -> a
throw ArithException
DivideByZero
| Bool
otherwise = forall a b. (Ord a, Num a, Num b) => (a -> b) -> a -> b
positivize (Integer -> Int -> Integer -> Scientific
longDiv Integer
0 Int
0) (forall a. Ratio a -> a
numerator Rational
rational)
where
longDiv :: Integer -> Int -> (Integer -> Scientific)
longDiv :: Integer -> Int -> Integer -> Scientific
longDiv !Integer
c !Int
e Integer
0 = Integer -> Int -> Scientific
Scientific Integer
c Int
e
longDiv !Integer
c !Int
e !Integer
n
| Integer
n forall a. Ord a => a -> a -> Bool
< Integer
d = Integer -> Int -> Integer -> Scientific
longDiv (Integer
c forall a. Num a => a -> a -> a
* Integer
10) (Int
e forall a. Num a => a -> a -> a
- Int
1) (Integer
n forall a. Num a => a -> a -> a
* Integer
10)
| Bool
otherwise = case Integer
n Integer -> Integer -> (# Integer, Integer #)
`quotRemInteger` Integer
d of
(#Integer
q, Integer
r#) -> Integer -> Int -> Integer -> Scientific
longDiv (Integer
c forall a. Num a => a -> a -> a
+ Integer
q) Int
e Integer
r
d :: Integer
d = forall a. Ratio a -> a
denominator Rational
rational
fromRationalRepetend
:: Maybe Int
-> Rational
-> Either (Scientific, Rational)
(Scientific, Maybe Int)
fromRationalRepetend :: Maybe Int
-> Rational
-> Either (Scientific, Rational) (Scientific, Maybe Int)
fromRationalRepetend Maybe Int
mbLimit Rational
rational =
case Maybe Int
mbLimit of
Maybe Int
Nothing -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Rational -> (Scientific, Maybe Int)
fromRationalRepetendUnlimited Rational
rational
Just Int
l -> Int
-> Rational
-> Either (Scientific, Rational) (Scientific, Maybe Int)
fromRationalRepetendLimited Int
l Rational
rational
fromRationalRepetendLimited
:: Int
-> Rational
-> Either (Scientific, Rational)
(Scientific, Maybe Int)
fromRationalRepetendLimited :: Int
-> Rational
-> Either (Scientific, Rational) (Scientific, Maybe Int)
fromRationalRepetendLimited Int
l Rational
rational
| Integer
d forall a. Eq a => a -> a -> Bool
== Integer
0 = forall a e. Exception e => e -> a
throw ArithException
DivideByZero
| Integer
num forall a. Ord a => a -> a -> Bool
< Integer
0 = case Integer -> Either (Scientific, Rational) (Scientific, Maybe Int)
longDiv (-Integer
num) of
Left (Scientific
s, Rational
r) -> forall a b. a -> Either a b
Left (-Scientific
s, -Rational
r)
Right (Scientific
s, Maybe Int
mb) -> forall a b. b -> Either a b
Right (-Scientific
s, Maybe Int
mb)
| Bool
otherwise = Integer -> Either (Scientific, Rational) (Scientific, Maybe Int)
longDiv Integer
num
where
num :: Integer
num = forall a. Ratio a -> a
numerator Rational
rational
longDiv :: Integer -> Either (Scientific, Rational) (Scientific, Maybe Int)
longDiv :: Integer -> Either (Scientific, Rational) (Scientific, Maybe Int)
longDiv = Integer
-> Int
-> Map Integer Int
-> Integer
-> Either (Scientific, Rational) (Scientific, Maybe Int)
longDivWithLimit Integer
0 Int
0 forall k a. Map k a
M.empty
longDivWithLimit
:: Integer
-> Int
-> M.Map Integer Int
-> (Integer -> Either (Scientific, Rational)
(Scientific, Maybe Int))
longDivWithLimit :: Integer
-> Int
-> Map Integer Int
-> Integer
-> Either (Scientific, Rational) (Scientific, Maybe Int)
longDivWithLimit !Integer
c !Int
e Map Integer Int
_ns Integer
0 = forall a b. b -> Either a b
Right (Integer -> Int -> Scientific
Scientific Integer
c Int
e, forall a. Maybe a
Nothing)
longDivWithLimit !Integer
c !Int
e Map Integer Int
ns !Integer
n
| Just Int
e' <- forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Integer
n Map Integer Int
ns = forall a b. b -> Either a b
Right (Integer -> Int -> Scientific
Scientific Integer
c Int
e, forall a. a -> Maybe a
Just (-Int
e'))
| Int
e forall a. Ord a => a -> a -> Bool
<= (-Int
l) = forall a b. a -> Either a b
Left (Integer -> Int -> Scientific
Scientific Integer
c Int
e, Integer
n forall a. Integral a => a -> a -> Ratio a
% (Integer
d forall a. Num a => a -> a -> a
* forall a. Num a => Int -> a
magnitude (-Int
e)))
| Integer
n forall a. Ord a => a -> a -> Bool
< Integer
d = let !ns' :: Map Integer Int
ns' = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Integer
n Int
e Map Integer Int
ns
in Integer
-> Int
-> Map Integer Int
-> Integer
-> Either (Scientific, Rational) (Scientific, Maybe Int)
longDivWithLimit (Integer
c forall a. Num a => a -> a -> a
* Integer
10) (Int
e forall a. Num a => a -> a -> a
- Int
1) Map Integer Int
ns' (Integer
n forall a. Num a => a -> a -> a
* Integer
10)
| Bool
otherwise = case Integer
n Integer -> Integer -> (# Integer, Integer #)
`quotRemInteger` Integer
d of
(#Integer
q, Integer
r#) -> Integer
-> Int
-> Map Integer Int
-> Integer
-> Either (Scientific, Rational) (Scientific, Maybe Int)
longDivWithLimit (Integer
c forall a. Num a => a -> a -> a
+ Integer
q) Int
e Map Integer Int
ns Integer
r
d :: Integer
d = forall a. Ratio a -> a
denominator Rational
rational
fromRationalRepetendUnlimited :: Rational -> (Scientific, Maybe Int)
fromRationalRepetendUnlimited :: Rational -> (Scientific, Maybe Int)
fromRationalRepetendUnlimited Rational
rational
| Integer
d forall a. Eq a => a -> a -> Bool
== Integer
0 = forall a e. Exception e => e -> a
throw ArithException
DivideByZero
| Integer
num forall a. Ord a => a -> a -> Bool
< Integer
0 = case Integer -> (Scientific, Maybe Int)
longDiv (-Integer
num) of
(Scientific
s, Maybe Int
mb) -> (-Scientific
s, Maybe Int
mb)
| Bool
otherwise = Integer -> (Scientific, Maybe Int)
longDiv Integer
num
where
num :: Integer
num = forall a. Ratio a -> a
numerator Rational
rational
longDiv :: Integer -> (Scientific, Maybe Int)
longDiv :: Integer -> (Scientific, Maybe Int)
longDiv = Integer
-> Int -> Map Integer Int -> Integer -> (Scientific, Maybe Int)
longDivNoLimit Integer
0 Int
0 forall k a. Map k a
M.empty
longDivNoLimit :: Integer
-> Int
-> M.Map Integer Int
-> (Integer -> (Scientific, Maybe Int))
longDivNoLimit :: Integer
-> Int -> Map Integer Int -> Integer -> (Scientific, Maybe Int)
longDivNoLimit !Integer
c !Int
e Map Integer Int
_ns Integer
0 = (Integer -> Int -> Scientific
Scientific Integer
c Int
e, forall a. Maybe a
Nothing)
longDivNoLimit !Integer
c !Int
e Map Integer Int
ns !Integer
n
| Just Int
e' <- forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Integer
n Map Integer Int
ns = (Integer -> Int -> Scientific
Scientific Integer
c Int
e, forall a. a -> Maybe a
Just (-Int
e'))
| Integer
n forall a. Ord a => a -> a -> Bool
< Integer
d = let !ns' :: Map Integer Int
ns' = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Integer
n Int
e Map Integer Int
ns
in Integer
-> Int -> Map Integer Int -> Integer -> (Scientific, Maybe Int)
longDivNoLimit (Integer
c forall a. Num a => a -> a -> a
* Integer
10) (Int
e forall a. Num a => a -> a -> a
- Int
1) Map Integer Int
ns' (Integer
n forall a. Num a => a -> a -> a
* Integer
10)
| Bool
otherwise = case Integer
n Integer -> Integer -> (# Integer, Integer #)
`quotRemInteger` Integer
d of
(#Integer
q, Integer
r#) -> Integer
-> Int -> Map Integer Int -> Integer -> (Scientific, Maybe Int)
longDivNoLimit (Integer
c forall a. Num a => a -> a -> a
+ Integer
q) Int
e Map Integer Int
ns Integer
r
d :: Integer
d = forall a. Ratio a -> a
denominator Rational
rational
toRationalRepetend
:: Scientific
-> Int
-> Rational
toRationalRepetend :: Scientific -> Int -> Rational
toRationalRepetend Scientific
s Int
r
| Int
r forall a. Ord a => a -> a -> Bool
< Int
0 = forall a. HasCallStack => [Char] -> a
error [Char]
"toRationalRepetend: Negative repetend index!"
| Int
r forall a. Ord a => a -> a -> Bool
>= Int
f = forall a. HasCallStack => [Char] -> a
error [Char]
"toRationalRepetend: Repetend index >= than number of digits in the fractional part!"
| Bool
otherwise = (forall a. Num a => Integer -> a
fromInteger Integer
nonRepetend forall a. Num a => a -> a -> a
+ Integer
repetend forall a. Integral a => a -> a -> Ratio a
% Integer
nines) forall a. Fractional a => a -> a -> a
/
forall a. Num a => Integer -> a
fromInteger (forall a. Num a => Int -> a
magnitude Int
r)
where
c :: Integer
c = Scientific -> Integer
coefficient Scientific
s
e :: Int
e = Scientific -> Int
base10Exponent Scientific
s
f :: Int
f = (-Int
e)
n :: Int
n = Int
f forall a. Num a => a -> a -> a
- Int
r
m :: Integer
m = forall a. Num a => Int -> a
magnitude Int
n
(#Integer
nonRepetend, Integer
repetend#) = Integer
c Integer -> Integer -> (# Integer, Integer #)
`quotRemInteger` Integer
m
nines :: Integer
nines = Integer
m forall a. Num a => a -> a -> a
- Integer
1
instance RealFrac Scientific where
properFraction :: forall b. Integral b => Scientific -> (b, Scientific)
properFraction s :: Scientific
s@(Scientific Integer
c Int
e)
| Int
e forall a. Ord a => a -> a -> Bool
< Int
0 = if Integer -> Int -> Bool
dangerouslySmall Integer
c Int
e
then (b
0, Scientific
s)
else case Integer
c Integer -> Integer -> (# Integer, Integer #)
`quotRemInteger` forall a. Num a => Int -> a
magnitude (-Int
e) of
(#Integer
q, Integer
r#) -> (forall a. Num a => Integer -> a
fromInteger Integer
q, Integer -> Int -> Scientific
Scientific Integer
r Int
e)
| Bool
otherwise = (forall a. Num a => Scientific -> a
toIntegral Scientific
s, Scientific
0)
{-# INLINABLE properFraction #-}
truncate :: forall b. Integral b => Scientific -> b
truncate = forall a. Num a => (Integer -> Int -> a) -> Scientific -> a
whenFloating forall a b. (a -> b) -> a -> b
$ \Integer
c Int
e ->
if Integer -> Int -> Bool
dangerouslySmall Integer
c Int
e
then b
0
else forall a. Num a => Integer -> a
fromInteger forall a b. (a -> b) -> a -> b
$ Integer
c Integer -> Integer -> Integer
`quotInteger` forall a. Num a => Int -> a
magnitude (-Int
e)
{-# INLINABLE truncate #-}
round :: forall b. Integral b => Scientific -> b
round = forall a. Num a => (Integer -> Int -> a) -> Scientific -> a
whenFloating forall a b. (a -> b) -> a -> b
$ \Integer
c Int
e ->
if Integer -> Int -> Bool
dangerouslySmall Integer
c Int
e
then b
0
else let (#Integer
q, Integer
r#) = Integer
c Integer -> Integer -> (# Integer, Integer #)
`quotRemInteger` forall a. Num a => Int -> a
magnitude (-Int
e)
n :: b
n = forall a. Num a => Integer -> a
fromInteger Integer
q
m :: b
m | Integer
r forall a. Ord a => a -> a -> Bool
< Integer
0 = b
n forall a. Num a => a -> a -> a
- b
1
| Bool
otherwise = b
n forall a. Num a => a -> a -> a
+ b
1
f :: Scientific
f = Integer -> Int -> Scientific
Scientific Integer
r Int
e
in case forall a. Num a => a -> a
signum forall a b. (a -> b) -> a -> b
$ Scientific -> Integer
coefficient forall a b. (a -> b) -> a -> b
$ forall a. Num a => a -> a
abs Scientific
f forall a. Num a => a -> a -> a
- Scientific
0.5 of
-1 -> b
n
Integer
0 -> if forall a. Integral a => a -> Bool
even b
n then b
n else b
m
Integer
1 -> b
m
Integer
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"round default defn: Bad value"
{-# INLINABLE round #-}
ceiling :: forall b. Integral b => Scientific -> b
ceiling = forall a. Num a => (Integer -> Int -> a) -> Scientific -> a
whenFloating forall a b. (a -> b) -> a -> b
$ \Integer
c Int
e ->
if Integer -> Int -> Bool
dangerouslySmall Integer
c Int
e
then if Integer
c forall a. Ord a => a -> a -> Bool
<= Integer
0
then b
0
else b
1
else case Integer
c Integer -> Integer -> (# Integer, Integer #)
`quotRemInteger` forall a. Num a => Int -> a
magnitude (-Int
e) of
(#Integer
q, Integer
r#) | Integer
r forall a. Ord a => a -> a -> Bool
<= Integer
0 -> forall a. Num a => Integer -> a
fromInteger Integer
q
| Bool
otherwise -> forall a. Num a => Integer -> a
fromInteger (Integer
q forall a. Num a => a -> a -> a
+ Integer
1)
{-# INLINABLE ceiling #-}
floor :: forall b. Integral b => Scientific -> b
floor = forall a. Num a => (Integer -> Int -> a) -> Scientific -> a
whenFloating forall a b. (a -> b) -> a -> b
$ \Integer
c Int
e ->
if Integer -> Int -> Bool
dangerouslySmall Integer
c Int
e
then if Integer
c forall a. Ord a => a -> a -> Bool
< Integer
0
then -b
1
else b
0
else forall a. Num a => Integer -> a
fromInteger (Integer
c Integer -> Integer -> Integer
`divInteger` forall a. Num a => Int -> a
magnitude (-Int
e))
{-# INLINABLE floor #-}
dangerouslySmall :: Integer -> Int -> Bool
dangerouslySmall :: Integer -> Int -> Bool
dangerouslySmall Integer
c Int
e = Int
e forall a. Ord a => a -> a -> Bool
< (-Int
limit) Bool -> Bool -> Bool
&& Int
e forall a. Ord a => a -> a -> Bool
< (-Integer -> Int
integerLog10' (forall a. Num a => a -> a
abs Integer
c)) forall a. Num a => a -> a -> a
- Int
1
{-# INLINE dangerouslySmall #-}
limit :: Int
limit :: Int
limit = Int
maxExpt
positivize :: (Ord a, Num a, Num b) => (a -> b) -> (a -> b)
positivize :: forall a b. (Ord a, Num a, Num b) => (a -> b) -> a -> b
positivize a -> b
f a
x | a
x forall a. Ord a => a -> a -> Bool
< a
0 = -(a -> b
f (-a
x))
| Bool
otherwise = a -> b
f a
x
{-# INLINE positivize #-}
whenFloating :: (Num a) => (Integer -> Int -> a) -> Scientific -> a
whenFloating :: forall a. Num a => (Integer -> Int -> a) -> Scientific -> a
whenFloating Integer -> Int -> a
f s :: Scientific
s@(Scientific Integer
c Int
e)
| Int
e forall a. Ord a => a -> a -> Bool
< Int
0 = Integer -> Int -> a
f Integer
c Int
e
| Bool
otherwise = forall a. Num a => Scientific -> a
toIntegral Scientific
s
{-# INLINE whenFloating #-}
toIntegral :: (Num a) => Scientific -> a
toIntegral :: forall a. Num a => Scientific -> a
toIntegral (Scientific Integer
c Int
e) = forall a. Num a => Integer -> a
fromInteger Integer
c forall a. Num a => a -> a -> a
* forall a. Num a => Int -> a
magnitude Int
e
{-# INLINE toIntegral #-}
fromFloatDigits :: (RealFloat a) => a -> Scientific
fromFloatDigits :: forall a. RealFloat a => a -> Scientific
fromFloatDigits a
0 = Scientific
0
fromFloatDigits a
rf = forall a b. (Ord a, Num a, Num b) => (a -> b) -> a -> b
positivize forall a. RealFloat a => a -> Scientific
fromPositiveRealFloat a
rf
where
fromPositiveRealFloat :: p -> Scientific
fromPositiveRealFloat p
r = [Int] -> Integer -> Int -> Scientific
go [Int]
digits Integer
0 Int
0
where
([Int]
digits, Int
e) = forall a. RealFloat a => Integer -> a -> ([Int], Int)
Numeric.floatToDigits Integer
10 p
r
go :: [Int] -> Integer -> Int -> Scientific
go :: [Int] -> Integer -> Int -> Scientific
go [] !Integer
c !Int
n = Integer -> Int -> Scientific
Scientific Integer
c (Int
e forall a. Num a => a -> a -> a
- Int
n)
go (Int
d:[Int]
ds) !Integer
c !Int
n = [Int] -> Integer -> Int -> Scientific
go [Int]
ds (Integer
c forall a. Num a => a -> a -> a
* Integer
10 forall a. Num a => a -> a -> a
+ forall a. Integral a => a -> Integer
toInteger Int
d) (Int
n forall a. Num a => a -> a -> a
+ Int
1)
{-# INLINABLE fromFloatDigits #-}
{-# SPECIALIZE fromFloatDigits :: Double -> Scientific #-}
{-# SPECIALIZE fromFloatDigits :: Float -> Scientific #-}
toRealFloat :: (RealFloat a) => Scientific -> a
toRealFloat :: forall a. RealFloat a => Scientific -> a
toRealFloat = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. a -> a
id forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. RealFloat a => Scientific -> Either a a
toBoundedRealFloat
{-# INLINABLE toRealFloat #-}
{-# INLINABLE toBoundedRealFloat #-}
{-# SPECIALIZE toRealFloat :: Scientific -> Double #-}
{-# SPECIALIZE toRealFloat :: Scientific -> Float #-}
{-# SPECIALIZE toBoundedRealFloat :: Scientific -> Either Double Double #-}
{-# SPECIALIZE toBoundedRealFloat :: Scientific -> Either Float Float #-}
toBoundedRealFloat :: forall a. (RealFloat a) => Scientific -> Either a a
toBoundedRealFloat :: forall a. RealFloat a => Scientific -> Either a a
toBoundedRealFloat s :: Scientific
s@(Scientific Integer
c Int
e)
| Integer
c forall a. Eq a => a -> a -> Bool
== Integer
0 = forall a b. b -> Either a b
Right a
0
| Int
e forall a. Ord a => a -> a -> Bool
> Int
limit = if Int
e forall a. Ord a => a -> a -> Bool
> Int
hiLimit then forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a. Num a => a -> a
sign (a
1forall a. Fractional a => a -> a -> a
/a
0)
else forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. Fractional a => Rational -> a
fromRational ((Integer
c forall a. Num a => a -> a -> a
* forall a. Num a => Int -> a
magnitude Int
e) forall a. Integral a => a -> a -> Ratio a
% Integer
1)
| Int
e forall a. Ord a => a -> a -> Bool
< -Int
limit = if Int
e forall a. Ord a => a -> a -> Bool
< Int
loLimit Bool -> Bool -> Bool
&& Int
e forall a. Num a => a -> a -> a
+ Int
d forall a. Ord a => a -> a -> Bool
< Int
loLimit then forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a. Num a => a -> a
sign a
0
else forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. Fractional a => Rational -> a
fromRational (Integer
c forall a. Integral a => a -> a -> Ratio a
% forall a. Num a => Int -> a
magnitude (-Int
e))
| Bool
otherwise = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. Fractional a => Rational -> a
fromRational (forall a. Real a => a -> Rational
toRational Scientific
s)
where
hiLimit, loLimit :: Int
hiLimit :: Int
hiLimit = forall a b. (RealFrac a, Integral b) => a -> b
ceiling (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
hi forall a. Num a => a -> a -> a
* Double
log10Radix)
loLimit :: Int
loLimit = forall a b. (RealFrac a, Integral b) => a -> b
floor (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lo forall a. Num a => a -> a -> a
* Double
log10Radix) forall a. Num a => a -> a -> a
-
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
digits forall a. Num a => a -> a -> a
* Double
log10Radix)
log10Radix :: Double
log10Radix :: Double
log10Radix = forall a. Floating a => a -> a -> a
logBase Double
10 forall a b. (a -> b) -> a -> b
$ forall a. Num a => Integer -> a
fromInteger Integer
radix
radix :: Integer
radix = forall a. RealFloat a => a -> Integer
floatRadix (forall a. HasCallStack => a
undefined :: a)
digits :: Int
digits = forall a. RealFloat a => a -> Int
floatDigits (forall a. HasCallStack => a
undefined :: a)
(Int
lo, Int
hi) = forall a. RealFloat a => a -> (Int, Int)
floatRange (forall a. HasCallStack => a
undefined :: a)
d :: Int
d = Integer -> Int
integerLog10' (forall a. Num a => a -> a
abs Integer
c)
sign :: a -> a
sign a
x | Integer
c forall a. Ord a => a -> a -> Bool
< Integer
0 = -a
x
| Bool
otherwise = a
x
toBoundedInteger :: forall i. (Integral i, Bounded i) => Scientific -> Maybe i
toBoundedInteger :: forall i. (Integral i, Bounded i) => Scientific -> Maybe i
toBoundedInteger Scientific
s
| Integer
c forall a. Eq a => a -> a -> Bool
== Integer
0 = Integer -> Maybe i
fromIntegerBounded Integer
0
| Bool
integral = if Bool
dangerouslyBig
then forall a. Maybe a
Nothing
else Integer -> Maybe i
fromIntegerBounded Integer
n
| Bool
otherwise = forall a. Maybe a
Nothing
where
c :: Integer
c = Scientific -> Integer
coefficient Scientific
s
integral :: Bool
integral = Int
e forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
|| Int
e' forall a. Ord a => a -> a -> Bool
>= Int
0
e :: Int
e = Scientific -> Int
base10Exponent Scientific
s
e' :: Int
e' = Scientific -> Int
base10Exponent Scientific
s'
s' :: Scientific
s' = Scientific -> Scientific
normalize Scientific
s
dangerouslyBig :: Bool
dangerouslyBig = Int
e forall a. Ord a => a -> a -> Bool
> Int
limit Bool -> Bool -> Bool
&&
Int
e forall a. Ord a => a -> a -> Bool
> Integer -> Int
integerLog10' (forall a. Ord a => a -> a -> a
max (forall a. Num a => a -> a
abs Integer
iMinBound) (forall a. Num a => a -> a
abs Integer
iMaxBound))
fromIntegerBounded :: Integer -> Maybe i
fromIntegerBounded :: Integer -> Maybe i
fromIntegerBounded Integer
i
| Integer
i forall a. Ord a => a -> a -> Bool
< Integer
iMinBound Bool -> Bool -> Bool
|| Integer
i forall a. Ord a => a -> a -> Bool
> Integer
iMaxBound = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Num a => Integer -> a
fromInteger Integer
i
iMinBound :: Integer
iMinBound = forall a. Integral a => a -> Integer
toInteger (forall a. Bounded a => a
minBound :: i)
iMaxBound :: Integer
iMaxBound = forall a. Integral a => a -> Integer
toInteger (forall a. Bounded a => a
maxBound :: i)
n :: Integer
n :: Integer
n = forall a. Num a => Scientific -> a
toIntegral Scientific
s'
{-# SPECIALIZE toBoundedInteger :: Scientific -> Maybe Int #-}
{-# SPECIALIZE toBoundedInteger :: Scientific -> Maybe Int8 #-}
{-# SPECIALIZE toBoundedInteger :: Scientific -> Maybe Int16 #-}
{-# SPECIALIZE toBoundedInteger :: Scientific -> Maybe Int32 #-}
{-# SPECIALIZE toBoundedInteger :: Scientific -> Maybe Int64 #-}
{-# SPECIALIZE toBoundedInteger :: Scientific -> Maybe Word #-}
{-# SPECIALIZE toBoundedInteger :: Scientific -> Maybe Word8 #-}
{-# SPECIALIZE toBoundedInteger :: Scientific -> Maybe Word16 #-}
{-# SPECIALIZE toBoundedInteger :: Scientific -> Maybe Word32 #-}
{-# SPECIALIZE toBoundedInteger :: Scientific -> Maybe Word64 #-}
floatingOrInteger :: (RealFloat r, Integral i) => Scientific -> Either r i
floatingOrInteger :: forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
floatingOrInteger Scientific
s
| Scientific -> Int
base10Exponent Scientific
s forall a. Ord a => a -> a -> Bool
>= Int
0 = forall a b. b -> Either a b
Right (forall a. Num a => Scientific -> a
toIntegral Scientific
s)
| Scientific -> Int
base10Exponent Scientific
s' forall a. Ord a => a -> a -> Bool
>= Int
0 = forall a b. b -> Either a b
Right (forall a. Num a => Scientific -> a
toIntegral Scientific
s')
| Bool
otherwise = forall a b. a -> Either a b
Left (forall a. RealFloat a => Scientific -> a
toRealFloat Scientific
s')
where
s' :: Scientific
s' = Scientific -> Scientific
normalize Scientific
s
isFloating :: Scientific -> Bool
isFloating :: Scientific -> Bool
isFloating = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> Bool
isInteger
isInteger :: Scientific -> Bool
isInteger :: Scientific -> Bool
isInteger Scientific
s = Scientific -> Int
base10Exponent Scientific
s forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
||
Scientific -> Int
base10Exponent Scientific
s' forall a. Ord a => a -> a -> Bool
>= Int
0
where
s' :: Scientific
s' = Scientific -> Scientific
normalize Scientific
s
instance Read Scientific where
readPrec :: ReadPrec Scientific
readPrec = forall a. ReadPrec a -> ReadPrec a
Read.parens forall a b. (a -> b) -> a -> b
$ forall a. ReadP a -> ReadPrec a
ReadPrec.lift (ReadP ()
ReadP.skipSpaces forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReadP Scientific
scientificP)
data SP = SP !Integer {-# UNPACK #-}!Int
scientificP :: ReadP Scientific
scientificP :: ReadP Scientific
scientificP = do
let positive :: ReadP Bool
positive = ((Char
'+' forall a. Eq a => a -> a -> Bool
==) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> ReadP Char
ReadP.satisfy Char -> Bool
isSign) forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
Bool
pos <- ReadP Bool
positive
let step :: Num a => a -> Int -> a
step :: forall a. Num a => a -> Int -> a
step a
a Int
digit = a
a forall a. Num a => a -> a -> a
* a
10 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
digit
{-# INLINE step #-}
Integer
n <- forall a. (a -> Int -> a) -> a -> ReadP a
foldDigits forall a. Num a => a -> Int -> a
step Integer
0
let s :: SP
s = Integer -> Int -> SP
SP Integer
n Int
0
fractional :: ReadP SP
fractional = forall a. (a -> Int -> a) -> a -> ReadP a
foldDigits (\(SP Integer
a Int
e) Int
digit ->
Integer -> Int -> SP
SP (forall a. Num a => a -> Int -> a
step Integer
a Int
digit) (Int
eforall a. Num a => a -> a -> a
-Int
1)) SP
s
SP Integer
coeff Int
expnt <- ((Char -> Bool) -> ReadP Char
ReadP.satisfy (forall a. Eq a => a -> a -> Bool
== Char
'.') forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReadP SP
fractional)
forall a. ReadP a -> ReadP a -> ReadP a
ReadP.<++ forall (m :: * -> *) a. Monad m => a -> m a
return SP
s
let signedCoeff :: Integer
signedCoeff | Bool
pos = Integer
coeff
| Bool
otherwise = (-Integer
coeff)
eP :: ReadP Int
eP = do Bool
posE <- ReadP Bool
positive
Int
e <- forall a. (a -> Int -> a) -> a -> ReadP a
foldDigits forall a. Num a => a -> Int -> a
step Int
0
if Bool
posE
then forall (m :: * -> *) a. Monad m => a -> m a
return Int
e
else forall (m :: * -> *) a. Monad m => a -> m a
return (-Int
e)
((Char -> Bool) -> ReadP Char
ReadP.satisfy Char -> Bool
isE forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
((Integer -> Int -> Scientific
Scientific Integer
signedCoeff forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
expnt forall a. Num a => a -> a -> a
+)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadP Int
eP)) forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Int -> Scientific
Scientific Integer
signedCoeff Int
expnt)
foldDigits :: (a -> Int -> a) -> a -> ReadP a
foldDigits :: forall a. (a -> Int -> a) -> a -> ReadP a
foldDigits a -> Int -> a
f a
z = do
Char
c <- (Char -> Bool) -> ReadP Char
ReadP.satisfy Char -> Bool
isDecimal
let digit :: Int
digit = Char -> Int
ord Char
c forall a. Num a => a -> a -> a
- Int
48
a :: a
a = a -> Int -> a
f a
z Int
digit
ReadP [Char]
ReadP.look forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> [Char] -> ReadP a
go a
a
where
go :: a -> [Char] -> ReadP a
go !a
a [] = forall (m :: * -> *) a. Monad m => a -> m a
return a
a
go !a
a (Char
c:[Char]
cs)
| Char -> Bool
isDecimal Char
c = do
Char
_ <- ReadP Char
ReadP.get
let digit :: Int
digit = Char -> Int
ord Char
c forall a. Num a => a -> a -> a
- Int
48
a -> [Char] -> ReadP a
go (a -> Int -> a
f a
a Int
digit) [Char]
cs
| Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return a
a
isDecimal :: Char -> Bool
isDecimal :: Char -> Bool
isDecimal Char
c = Char
c forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'9'
{-# INLINE isDecimal #-}
isSign :: Char -> Bool
isSign :: Char -> Bool
isSign Char
c = Char
c forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'+'
{-# INLINE isSign #-}
isE :: Char -> Bool
isE :: Char -> Bool
isE Char
c = Char
c forall a. Eq a => a -> a -> Bool
== Char
'e' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'E'
{-# INLINE isE #-}
instance Show Scientific where
showsPrec :: Int -> Scientific -> ShowS
showsPrec Int
d Scientific
s
| Scientific -> Integer
coefficient Scientific
s forall a. Ord a => a -> a -> Bool
< Integer
0 = Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
prefixMinusPrec) forall a b. (a -> b) -> a -> b
$
Char -> ShowS
showChar Char
'-' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> ShowS
showPositive (-Scientific
s)
| Bool
otherwise = Scientific -> ShowS
showPositive Scientific
s
where
prefixMinusPrec :: Int
prefixMinusPrec :: Int
prefixMinusPrec = Int
6
showPositive :: Scientific -> ShowS
showPositive :: Scientific -> ShowS
showPositive = [Char] -> ShowS
showString forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Int], Int) -> [Char]
fmtAsGeneric forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> ([Int], Int)
toDecimalDigits
fmtAsGeneric :: ([Int], Int) -> String
fmtAsGeneric :: ([Int], Int) -> [Char]
fmtAsGeneric x :: ([Int], Int)
x@([Int]
_is, Int
e)
| Int
e forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
e forall a. Ord a => a -> a -> Bool
> Int
7 = ([Int], Int) -> [Char]
fmtAsExponent ([Int], Int)
x
| Bool
otherwise = ([Int], Int) -> [Char]
fmtAsFixed ([Int], Int)
x
fmtAsExponent :: ([Int], Int) -> String
fmtAsExponent :: ([Int], Int) -> [Char]
fmtAsExponent ([Int]
is, Int
e) =
case [Char]
ds of
[Char]
"0" -> [Char]
"0.0e0"
[Char
d] -> Char
d forall a. a -> [a] -> [a]
: Char
'.' forall a. a -> [a] -> [a]
:Char
'0' forall a. a -> [a] -> [a]
: Char
'e' forall a. a -> [a] -> [a]
: [Char]
show_e'
(Char
d:[Char]
ds') -> Char
d forall a. a -> [a] -> [a]
: Char
'.' forall a. a -> [a] -> [a]
: [Char]
ds' forall a. [a] -> [a] -> [a]
++ (Char
'e' forall a. a -> [a] -> [a]
: [Char]
show_e')
[] -> forall a. HasCallStack => [Char] -> a
error [Char]
"formatScientific/doFmt/FFExponent: []"
where
show_e' :: [Char]
show_e' = forall a. Show a => a -> [Char]
show (Int
eforall a. Num a => a -> a -> a
-Int
1)
ds :: [Char]
ds = forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
intToDigit [Int]
is
fmtAsFixed :: ([Int], Int) -> String
fmtAsFixed :: ([Int], Int) -> [Char]
fmtAsFixed ([Int]
is, Int
e)
| Int
e forall a. Ord a => a -> a -> Bool
<= Int
0 = Char
'0'forall a. a -> [a] -> [a]
:Char
'.'forall a. a -> [a] -> [a]
:(forall a. Int -> a -> [a]
replicate (-Int
e) Char
'0' forall a. [a] -> [a] -> [a]
++ [Char]
ds)
| Bool
otherwise =
let
f :: t -> [Char] -> ShowS
f t
0 [Char]
s [Char]
rs = ShowS
mk0 (forall a. [a] -> [a]
reverse [Char]
s) forall a. [a] -> [a] -> [a]
++ Char
'.'forall a. a -> [a] -> [a]
:ShowS
mk0 [Char]
rs
f t
n [Char]
s [Char]
"" = t -> [Char] -> ShowS
f (t
nforall a. Num a => a -> a -> a
-t
1) (Char
'0'forall a. a -> [a] -> [a]
:[Char]
s) [Char]
""
f t
n [Char]
s (Char
r:[Char]
rs) = t -> [Char] -> ShowS
f (t
nforall a. Num a => a -> a -> a
-t
1) (Char
rforall a. a -> [a] -> [a]
:[Char]
s) [Char]
rs
in
forall {t}. (Eq t, Num t) => t -> [Char] -> ShowS
f Int
e [Char]
"" [Char]
ds
where
mk0 :: ShowS
mk0 [Char]
"" = [Char]
"0"
mk0 [Char]
ls = [Char]
ls
ds :: [Char]
ds = forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
intToDigit [Int]
is
formatScientific :: FPFormat
-> Maybe Int
-> Scientific
-> String
formatScientific :: FPFormat -> Maybe Int -> Scientific -> [Char]
formatScientific FPFormat
format Maybe Int
mbDecs Scientific
s
| Scientific -> Integer
coefficient Scientific
s forall a. Ord a => a -> a -> Bool
< Integer
0 = Char
'-'forall a. a -> [a] -> [a]
:Scientific -> [Char]
formatPositiveScientific (-Scientific
s)
| Bool
otherwise = Scientific -> [Char]
formatPositiveScientific Scientific
s
where
formatPositiveScientific :: Scientific -> String
formatPositiveScientific :: Scientific -> [Char]
formatPositiveScientific Scientific
s' = case FPFormat
format of
FPFormat
Generic -> ([Int], Int) -> [Char]
fmtAsGeneric forall a b. (a -> b) -> a -> b
$ Scientific -> ([Int], Int)
toDecimalDigits Scientific
s'
FPFormat
Exponent -> ([Int], Int) -> [Char]
fmtAsExponentMbDecs forall a b. (a -> b) -> a -> b
$ Scientific -> ([Int], Int)
toDecimalDigits Scientific
s'
FPFormat
Fixed -> ([Int], Int) -> [Char]
fmtAsFixedMbDecs forall a b. (a -> b) -> a -> b
$ Scientific -> ([Int], Int)
toDecimalDigits Scientific
s'
fmtAsGeneric :: ([Int], Int) -> String
fmtAsGeneric :: ([Int], Int) -> [Char]
fmtAsGeneric x :: ([Int], Int)
x@([Int]
_is, Int
e)
| Int
e forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
e forall a. Ord a => a -> a -> Bool
> Int
7 = ([Int], Int) -> [Char]
fmtAsExponentMbDecs ([Int], Int)
x
| Bool
otherwise = ([Int], Int) -> [Char]
fmtAsFixedMbDecs ([Int], Int)
x
fmtAsExponentMbDecs :: ([Int], Int) -> String
fmtAsExponentMbDecs :: ([Int], Int) -> [Char]
fmtAsExponentMbDecs ([Int], Int)
x = case Maybe Int
mbDecs of
Maybe Int
Nothing -> ([Int], Int) -> [Char]
fmtAsExponent ([Int], Int)
x
Just Int
dec -> Int -> ([Int], Int) -> [Char]
fmtAsExponentDecs Int
dec ([Int], Int)
x
fmtAsFixedMbDecs :: ([Int], Int) -> String
fmtAsFixedMbDecs :: ([Int], Int) -> [Char]
fmtAsFixedMbDecs ([Int], Int)
x = case Maybe Int
mbDecs of
Maybe Int
Nothing -> ([Int], Int) -> [Char]
fmtAsFixed ([Int], Int)
x
Just Int
dec -> Int -> ([Int], Int) -> [Char]
fmtAsFixedDecs Int
dec ([Int], Int)
x
fmtAsExponentDecs :: Int -> ([Int], Int) -> String
fmtAsExponentDecs :: Int -> ([Int], Int) -> [Char]
fmtAsExponentDecs Int
dec ([Int]
is, Int
e) =
let dec' :: Int
dec' = forall a. Ord a => a -> a -> a
max Int
dec Int
1 in
case [Int]
is of
[Int
0] -> Char
'0' forall a. a -> [a] -> [a]
:Char
'.' forall a. a -> [a] -> [a]
: forall a. Int -> [a] -> [a]
take Int
dec' (forall a. a -> [a]
repeat Char
'0') forall a. [a] -> [a] -> [a]
++ [Char]
"e0"
[Int]
_ ->
let
(Int
ei,[Int]
is') = Int -> [Int] -> (Int, [Int])
roundTo (Int
dec'forall a. Num a => a -> a -> a
+Int
1) [Int]
is
(Char
d:[Char]
ds') = forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
intToDigit (if Int
ei forall a. Ord a => a -> a -> Bool
> Int
0 then forall a. [a] -> [a]
init [Int]
is' else [Int]
is')
in
Char
dforall a. a -> [a] -> [a]
:Char
'.'forall a. a -> [a] -> [a]
:[Char]
ds' forall a. [a] -> [a] -> [a]
++ Char
'e'forall a. a -> [a] -> [a]
:forall a. Show a => a -> [Char]
show (Int
eforall a. Num a => a -> a -> a
-Int
1forall a. Num a => a -> a -> a
+Int
ei)
fmtAsFixedDecs :: Int -> ([Int], Int) -> String
fmtAsFixedDecs :: Int -> ([Int], Int) -> [Char]
fmtAsFixedDecs Int
dec ([Int]
is, Int
e) =
let dec' :: Int
dec' = forall a. Ord a => a -> a -> a
max Int
dec Int
0 in
if Int
e forall a. Ord a => a -> a -> Bool
>= Int
0 then
let
(Int
ei,[Int]
is') = Int -> [Int] -> (Int, [Int])
roundTo (Int
dec' forall a. Num a => a -> a -> a
+ Int
e) [Int]
is
([Char]
ls,[Char]
rs) = forall a. Int -> [a] -> ([a], [a])
splitAt (Int
eforall a. Num a => a -> a -> a
+Int
ei) (forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
intToDigit [Int]
is')
in
ShowS
mk0 [Char]
ls forall a. [a] -> [a] -> [a]
++ (if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
rs then [Char]
"" else Char
'.'forall a. a -> [a] -> [a]
:[Char]
rs)
else
let
(Int
ei,[Int]
is') = Int -> [Int] -> (Int, [Int])
roundTo Int
dec' (forall a. Int -> a -> [a]
replicate (-Int
e) Int
0 forall a. [a] -> [a] -> [a]
++ [Int]
is)
Char
d:[Char]
ds' = forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
intToDigit (if Int
ei forall a. Ord a => a -> a -> Bool
> Int
0 then [Int]
is' else Int
0forall a. a -> [a] -> [a]
:[Int]
is')
in
Char
d forall a. a -> [a] -> [a]
: (if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
ds' then [Char]
"" else Char
'.'forall a. a -> [a] -> [a]
:[Char]
ds')
where
mk0 :: ShowS
mk0 [Char]
ls = case [Char]
ls of { [Char]
"" -> [Char]
"0" ; [Char]
_ -> [Char]
ls}
toDecimalDigits :: Scientific -> ([Int], Int)
toDecimalDigits :: Scientific -> ([Int], Int)
toDecimalDigits (Scientific Integer
0 Int
_) = ([Int
0], Int
0)
toDecimalDigits (Scientific Integer
c' Int
e') =
case Integer -> Int -> Scientific
normalizePositive Integer
c' Int
e' of
Scientific Integer
c Int
e -> Integer -> Int -> [Int] -> ([Int], Int)
go Integer
c Int
0 []
where
go :: Integer -> Int -> [Int] -> ([Int], Int)
go :: Integer -> Int -> [Int] -> ([Int], Int)
go Integer
0 !Int
n [Int]
ds = ([Int]
ds, Int
ne) where !ne :: Int
ne = Int
n forall a. Num a => a -> a -> a
+ Int
e
go Integer
i !Int
n [Int]
ds = case Integer
i Integer -> Integer -> (# Integer, Integer #)
`quotRemInteger` Integer
10 of
(# Integer
q, Integer
r #) -> Integer -> Int -> [Int] -> ([Int], Int)
go Integer
q (Int
nforall a. Num a => a -> a -> a
+Int
1) (Int
dforall a. a -> [a] -> [a]
:[Int]
ds)
where
!d :: Int
d = forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
r
normalize :: Scientific -> Scientific
normalize :: Scientific -> Scientific
normalize (Scientific Integer
c Int
e)
| Integer
c forall a. Ord a => a -> a -> Bool
> Integer
0 = Integer -> Int -> Scientific
normalizePositive Integer
c Int
e
| Integer
c forall a. Ord a => a -> a -> Bool
< Integer
0 = -(Integer -> Int -> Scientific
normalizePositive (-Integer
c) Int
e)
| Bool
otherwise = Integer -> Int -> Scientific
Scientific Integer
0 Int
0
normalizePositive :: Integer -> Int -> Scientific
normalizePositive :: Integer -> Int -> Scientific
normalizePositive !Integer
c !Int
e = case Integer -> Integer -> (# Integer, Integer #)
quotRemInteger Integer
c Integer
10 of
(# Integer
c', Integer
r #)
| Integer
r forall a. Eq a => a -> a -> Bool
== Integer
0 -> Integer -> Int -> Scientific
normalizePositive Integer
c' (Int
eforall a. Num a => a -> a -> a
+Int
1)
| Bool
otherwise -> Integer -> Int -> Scientific
Scientific Integer
c Int
e