{-# LANGUAGE CPP, OverloadedStrings #-}
#if __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Trustworthy #-}
#endif

-- |
-- Module:    Data.Text.Lazy.Builder.RealFloat
-- Copyright: (c) The University of Glasgow 1994-2002
-- License:   see libraries/base/LICENSE
--
-- Write a floating point value to a 'Builder'.

module Data.Text.Lazy.Builder.RealFloat
    (
      FPFormat(..)
    , realFloat
    , formatRealFloat
    ) where

import Data.Array.Base (unsafeAt)
import Data.Array.IArray
import Data.Text.Internal.Builder.Functions ((<>), i2d)
import Data.Text.Lazy.Builder.Int (decimal)
import Data.Text.Internal.Builder.RealFloat.Functions (roundTo)
import Data.Text.Lazy.Builder
import qualified Data.Text as T
#if MIN_VERSION_base(4,11,0)
import Prelude hiding ((<>))
#endif

-- | Control the rendering of floating point numbers.
data FPFormat = Exponent
              -- ^ Scientific notation (e.g. @2.3e123@).
              | Fixed
              -- ^ Standard decimal notation.
              | Generic
              -- ^ Use decimal notation for values between @0.1@ and
              -- @9,999,999@, and scientific notation otherwise.
                deriving (Int -> FPFormat
FPFormat -> Int
FPFormat -> [FPFormat]
FPFormat -> FPFormat
FPFormat -> FPFormat -> [FPFormat]
FPFormat -> FPFormat -> FPFormat -> [FPFormat]
(FPFormat -> FPFormat)
-> (FPFormat -> FPFormat)
-> (Int -> FPFormat)
-> (FPFormat -> Int)
-> (FPFormat -> [FPFormat])
-> (FPFormat -> FPFormat -> [FPFormat])
-> (FPFormat -> FPFormat -> [FPFormat])
-> (FPFormat -> FPFormat -> FPFormat -> [FPFormat])
-> Enum FPFormat
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: FPFormat -> FPFormat -> FPFormat -> [FPFormat]
$cenumFromThenTo :: FPFormat -> FPFormat -> FPFormat -> [FPFormat]
enumFromTo :: FPFormat -> FPFormat -> [FPFormat]
$cenumFromTo :: FPFormat -> FPFormat -> [FPFormat]
enumFromThen :: FPFormat -> FPFormat -> [FPFormat]
$cenumFromThen :: FPFormat -> FPFormat -> [FPFormat]
enumFrom :: FPFormat -> [FPFormat]
$cenumFrom :: FPFormat -> [FPFormat]
fromEnum :: FPFormat -> Int
$cfromEnum :: FPFormat -> Int
toEnum :: Int -> FPFormat
$ctoEnum :: Int -> FPFormat
pred :: FPFormat -> FPFormat
$cpred :: FPFormat -> FPFormat
succ :: FPFormat -> FPFormat
$csucc :: FPFormat -> FPFormat
External instance of the constraint type Show Int
External instance of the constraint type Show Int
External instance of the constraint type forall a. (a ~ Char) => IsString [a]
External instance of the constraint type forall a. (a ~ Char) => IsString [a]
External instance of the constraint type Num Int
External instance of the constraint type Eq Int
External instance of the constraint type Ord Int
External instance of the constraint type Enum Int
Enum, ReadPrec [FPFormat]
ReadPrec FPFormat
Int -> ReadS FPFormat
ReadS [FPFormat]
(Int -> ReadS FPFormat)
-> ReadS [FPFormat]
-> ReadPrec FPFormat
-> ReadPrec [FPFormat]
-> Read FPFormat
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FPFormat]
$creadListPrec :: ReadPrec [FPFormat]
readPrec :: ReadPrec FPFormat
$creadPrec :: ReadPrec FPFormat
readList :: ReadS [FPFormat]
$creadList :: ReadS [FPFormat]
readsPrec :: Int -> ReadS FPFormat
$creadsPrec :: Int -> ReadS FPFormat
External instance of the constraint type Monad ReadPrec
External instance of the constraint type Monad ReadPrec
Instance of class: Read of the constraint type Read FPFormat
Read, Int -> FPFormat -> ShowS
[FPFormat] -> ShowS
FPFormat -> [Char]
(Int -> FPFormat -> ShowS)
-> (FPFormat -> [Char]) -> ([FPFormat] -> ShowS) -> Show FPFormat
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [FPFormat] -> ShowS
$cshowList :: [FPFormat] -> ShowS
show :: FPFormat -> [Char]
$cshow :: FPFormat -> [Char]
showsPrec :: Int -> FPFormat -> ShowS
$cshowsPrec :: Int -> FPFormat -> ShowS
Show)

-- | Show a signed 'RealFloat' value to full precision,
-- using standard decimal notation for arguments whose absolute value lies
-- between @0.1@ and @9,999,999@, and scientific notation otherwise.
realFloat :: (RealFloat a) => a -> Builder
{-# SPECIALIZE realFloat :: Float -> Builder #-}
{-# SPECIALIZE realFloat :: Double -> Builder #-}
realFloat :: a -> Builder
realFloat a
x = FPFormat -> Maybe Int -> a -> Builder
forall a. RealFloat a => FPFormat -> Maybe Int -> a -> Builder
Evidence bound by a type signature of the constraint type RealFloat a
formatRealFloat FPFormat
Generic Maybe Int
forall a. Maybe a
Nothing a
x

-- | Encode a signed 'RealFloat' according to 'FPFormat' and optionally requested precision.
--
-- This corresponds to the @show{E,F,G}Float@ operations provided by @base@'s "Numeric" module.
--
-- __NOTE__: The functions in @base-4.12@ changed the serialisation in
-- case of a @Just 0@ precision; this version of @text@ still provides
-- the serialisation as implemented in @base-4.11@. The next major
-- version of @text@ will switch to the more correct @base-4.12@ serialisation.
formatRealFloat :: (RealFloat a) =>
                   FPFormat
                -> Maybe Int  -- ^ Number of decimal places to render.
                -> a
                -> Builder
{-# SPECIALIZE formatRealFloat :: FPFormat -> Maybe Int -> Float -> Builder #-}
{-# SPECIALIZE formatRealFloat :: FPFormat -> Maybe Int -> Double -> Builder #-}
formatRealFloat :: FPFormat -> Maybe Int -> a -> Builder
formatRealFloat FPFormat
fmt Maybe Int
decs a
x
   | a -> Bool
forall a. RealFloat a => a -> Bool
Evidence bound by a type signature of the constraint type RealFloat a
isNaN a
x                   = Builder
"NaN"
   | a -> Bool
forall a. RealFloat a => a -> Bool
Evidence bound by a type signature of the constraint type RealFloat a
isInfinite a
x              = if a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type forall a. Real a => Ord a
External instance of the constraint type forall a. RealFrac a => Real a
External instance of the constraint type forall a. RealFloat a => RealFrac a
Evidence bound by a type signature of the constraint type RealFloat a
< a
0 then Builder
"-Infinity" else Builder
"Infinity"
   | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type forall a. Real a => Ord a
External instance of the constraint type forall a. RealFrac a => Real a
External instance of the constraint type forall a. RealFloat a => RealFrac a
Evidence bound by a type signature of the constraint type RealFloat a
< a
0 Bool -> Bool -> Bool
|| a -> Bool
forall a. RealFloat a => a -> Bool
Evidence bound by a type signature of the constraint type RealFloat a
isNegativeZero a
x = Char -> Builder
singleton Char
'-' Builder -> Builder -> Builder
<> FPFormat -> ([Int], Int) -> Builder
doFmt FPFormat
fmt (a -> ([Int], Int)
forall a. RealFloat a => a -> ([Int], Int)
Evidence bound by a type signature of the constraint type RealFloat a
floatToDigits (-a
x))
   | Bool
otherwise                 = FPFormat -> ([Int], Int) -> Builder
doFmt FPFormat
fmt (a -> ([Int], Int)
forall a. RealFloat a => a -> ([Int], Int)
Evidence bound by a type signature of the constraint type RealFloat a
floatToDigits a
x)
 where
  doFmt :: FPFormat -> ([Int], Int) -> Builder
doFmt FPFormat
format ([Int]
is, Int
e) =
    let ds :: [Char]
ds = (Int -> Char) -> [Int] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
i2d [Int]
is in
    case FPFormat
format of
     FPFormat
Generic ->
      FPFormat -> ([Int], Int) -> Builder
doFmt (if Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
0 Bool -> Bool -> Bool
|| Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
> Int
7 then FPFormat
Exponent else FPFormat
Fixed)
            ([Int]
is,Int
e)
     FPFormat
Exponent ->
      case Maybe Int
decs of
       Maybe Int
Nothing ->
        let show_e' :: Builder
show_e' = Int -> Builder
forall a. Integral a => a -> Builder
External instance of the constraint type Integral Int
decimal (Int
eInt -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
-Int
1) in
        case [Char]
ds of
          [Char]
"0"     -> Builder
"0.0e0"
          [Char
d]     -> Char -> Builder
singleton Char
d Builder -> Builder -> Builder
<> Builder
".0e" Builder -> Builder -> Builder
<> Builder
show_e'
          (Char
d:[Char]
ds') -> Char -> Builder
singleton Char
d Builder -> Builder -> Builder
<> Char -> Builder
singleton Char
'.' Builder -> Builder -> Builder
<> [Char] -> Builder
fromString [Char]
ds' Builder -> Builder -> Builder
<> Char -> Builder
singleton Char
'e' Builder -> Builder -> Builder
<> Builder
show_e'
          []      -> [Char] -> Builder
forall a. HasCallStack => [Char] -> a
error [Char]
"formatRealFloat/doFmt/Exponent/Nothing: []"
       Just Int
dec ->
        let dec' :: Int
dec' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
External instance of the constraint type Ord Int
max Int
dec Int
1 in
        case [Int]
is of
         [Int
0] -> Builder
"0." Builder -> Builder -> Builder
<> Text -> Builder
fromText (Int -> Text -> Text
T.replicate Int
dec' Text
"0") Builder -> Builder -> Builder
<> Builder
"e0"
         [Int]
_ ->
          let (Int
ei,[Int]
is') = Int -> [Int] -> (Int, [Int])
roundTo (Int
dec'Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+Int
1) [Int]
is
              is'' :: [Char]
is'' = (Int -> Char) -> [Int] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
i2d (if Int
ei Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
> Int
0 then [Int] -> [Int]
forall a. [a] -> [a]
init [Int]
is' else [Int]
is')
          in case [Char]
is'' of
               [] -> [Char] -> Builder
forall a. HasCallStack => [Char] -> a
error [Char]
"formatRealFloat/doFmt/Exponent/Just: []"
               (Char
d:[Char]
ds') -> Char -> Builder
singleton Char
d Builder -> Builder -> Builder
<> Char -> Builder
singleton Char
'.' Builder -> Builder -> Builder
<> [Char] -> Builder
fromString [Char]
ds' Builder -> Builder -> Builder
<> Char -> Builder
singleton Char
'e' Builder -> Builder -> Builder
<> Int -> Builder
forall a. Integral a => a -> Builder
External instance of the constraint type Integral Int
decimal (Int
eInt -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
-Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+Int
ei)
     FPFormat
Fixed ->
      let
       mk0 :: [Char] -> Builder
mk0 [Char]
ls = case [Char]
ls of { [Char]
"" -> Builder
"0" ; [Char]
_ -> [Char] -> Builder
fromString [Char]
ls}
      in
      case Maybe Int
decs of
       Maybe Int
Nothing
          | Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
<= Int
0    -> Builder
"0." Builder -> Builder -> Builder
<> Text -> Builder
fromText (Int -> Text -> Text
T.replicate (-Int
e) Text
"0") Builder -> Builder -> Builder
<> [Char] -> Builder
fromString [Char]
ds
          | Bool
otherwise ->
             let
                f :: a -> [Char] -> [Char] -> Builder
f a
0 [Char]
s    [Char]
rs  = [Char] -> Builder
mk0 (ShowS
forall a. [a] -> [a]
reverse [Char]
s) Builder -> Builder -> Builder
<> Char -> Builder
singleton Char
'.' Builder -> Builder -> Builder
<> [Char] -> Builder
mk0 [Char]
rs
                f a
n [Char]
s    [Char]
""  = a -> [Char] -> [Char] -> Builder
f (a
na -> a -> a
forall a. Num a => a -> a -> a
Evidence bound by a type signature of the constraint type Num a
-a
1) (Char
'0'Char -> ShowS
forall a. a -> [a] -> [a]
:[Char]
s) [Char]
""
                f a
n [Char]
s (Char
r:[Char]
rs) = a -> [Char] -> [Char] -> Builder
f (a
na -> a -> a
forall a. Num a => a -> a -> a
Evidence bound by a type signature of the constraint type Num a
-a
1) (Char
rChar -> ShowS
forall a. a -> [a] -> [a]
:[Char]
s) [Char]
rs
             in
                Int -> [Char] -> [Char] -> Builder
forall {a}. (Eq a, Num a) => a -> [Char] -> [Char] -> Builder
External instance of the constraint type Num Int
External instance of the constraint type Eq Int
f Int
e [Char]
"" [Char]
ds
       Just Int
dec ->
        let dec' :: Int
dec' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
External instance of the constraint type Ord Int
max Int
dec Int
0 in
        if Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
>= Int
0 then
         let
          (Int
ei,[Int]
is') = Int -> [Int] -> (Int, [Int])
roundTo (Int
dec' Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
e) [Int]
is
          ([Char]
ls,[Char]
rs)  = Int -> [Char] -> ([Char], [Char])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int
eInt -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+Int
ei) ((Int -> Char) -> [Int] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
i2d [Int]
is')
         in
         [Char] -> Builder
mk0 [Char]
ls Builder -> Builder -> Builder
<> (if [Char] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
External instance of the constraint type Foldable []
null [Char]
rs then Builder
"" else Char -> Builder
singleton Char
'.' Builder -> Builder -> Builder
<> [Char] -> Builder
fromString [Char]
rs)
        else
         let (Int
ei,[Int]
is') = Int -> [Int] -> (Int, [Int])
roundTo Int
dec' (Int -> Int -> [Int]
forall a. Int -> a -> [a]
replicate (-Int
e) Int
0 [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
is)
             is'' :: [Char]
is'' = (Int -> Char) -> [Int] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
i2d (if Int
ei Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
> Int
0 then [Int]
is' else Int
0Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
is')
         in case [Char]
is'' of
              [] -> [Char] -> Builder
forall a. HasCallStack => [Char] -> a
error [Char]
"formatRealFloat/doFmt/Fixed: []"
              (Char
d:[Char]
ds') -> Char -> Builder
singleton Char
d Builder -> Builder -> Builder
<> (if [Char] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
External instance of the constraint type Foldable []
null [Char]
ds' then Builder
"" else Char -> Builder
singleton Char
'.' Builder -> Builder -> Builder
<> [Char] -> Builder
fromString [Char]
ds')


-- Based on "Printing Floating-Point Numbers Quickly and Accurately"
-- by R.G. Burger and R.K. Dybvig in PLDI 96.
-- This version uses a much slower logarithm estimator. It should be improved.

-- | 'floatToDigits' takes a base and a non-negative 'RealFloat' number,
-- and returns a list of digits and an exponent.
-- In particular, if @x>=0@, and
--
-- > floatToDigits base x = ([d1,d2,...,dn], e)
--
-- then
--
--      (1) @n >= 1@
--
--      (2) @x = 0.d1d2...dn * (base**e)@
--
--      (3) @0 <= di <= base-1@

floatToDigits :: (RealFloat a) => a -> ([Int], Int)
{-# SPECIALIZE floatToDigits :: Float -> ([Int], Int) #-}
{-# SPECIALIZE floatToDigits :: Double -> ([Int], Int) #-}
floatToDigits :: a -> ([Int], Int)
floatToDigits a
0 = ([Int
0], Int
0)
floatToDigits a
x =
 let
  (Integer
f0, Int
e0) = a -> (Integer, Int)
forall a. RealFloat a => a -> (Integer, Int)
Evidence bound by a type signature of the constraint type RealFloat a
decodeFloat a
x
  (Int
minExp0, Int
_) = a -> (Int, Int)
forall a. RealFloat a => a -> (Int, Int)
Evidence bound by a type signature of the constraint type RealFloat a
floatRange a
x
  p :: Int
p = a -> Int
forall a. RealFloat a => a -> Int
Evidence bound by a type signature of the constraint type RealFloat a
floatDigits a
x
  b :: Integer
b = a -> Integer
forall a. RealFloat a => a -> Integer
Evidence bound by a type signature of the constraint type RealFloat a
floatRadix a
x
  minExp :: Int
minExp = Int
minExp0 Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
p -- the real minimum exponent
  -- Haskell requires that f be adjusted so denormalized numbers
  -- will have an impossibly low exponent.  Adjust for this.
  (Integer
f, Int
e) =
   let n :: Int
n = Int
minExp Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
e0 in
   if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
> Int
0 then (Integer
f0 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
External instance of the constraint type Integral Integer
`quot` (Integer -> Int -> Integer
expt Integer
b Int
n), Int
e0Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+Int
n) else (Integer
f0, Int
e0)
  (Integer
r, Integer
s, Integer
mUp, Integer
mDn) =
   if Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
>= Int
0 then
    let be :: Integer
be = Integer -> Int -> Integer
expt Integer
b Int
e in
    if Integer
f Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Integer
== Integer -> Int -> Integer
expt Integer
b (Int
pInt -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
-Int
1) then
      (Integer
fInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
*Integer
beInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
*Integer
bInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
*Integer
2, Integer
2Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
*Integer
b, Integer
beInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
*Integer
b, Integer
be)     -- according to Burger and Dybvig
    else
      (Integer
fInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
*Integer
beInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
*Integer
2, Integer
2, Integer
be, Integer
be)
   else
    if Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
> Int
minExp Bool -> Bool -> Bool
&& Integer
f Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Integer
== Integer -> Int -> Integer
expt Integer
b (Int
pInt -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
-Int
1) then
      (Integer
fInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
*Integer
bInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
*Integer
2, Integer -> Int -> Integer
expt Integer
b (-Int
eInt -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+Int
1)Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
*Integer
2, Integer
b, Integer
1)
    else
      (Integer
fInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
*Integer
2, Integer -> Int -> Integer
expt Integer
b (-Int
e)Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
*Integer
2, Integer
1, Integer
1)
  k :: Int
  k :: Int
k =
   let
    k0 :: Int
    k0 :: Int
k0 =
     if Integer
b Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Integer
== Integer
2 then
        -- logBase 10 2 is very slightly larger than 8651/28738
        -- (about 5.3558e-10), so if log x >= 0, the approximation
        -- k1 is too small, hence we add one and need one fixup step less.
        -- If log x < 0, the approximation errs rather on the high side.
        -- That is usually more than compensated for by ignoring the
        -- fractional part of logBase 2 x, but when x is a power of 1/2
        -- or slightly larger and the exponent is a multiple of the
        -- denominator of the rational approximation to logBase 10 2,
        -- k1 is larger than logBase 10 x. If k1 > 1 + logBase 10 x,
        -- we get a leading zero-digit we don't want.
        -- With the approximation 3/10, this happened for
        -- 0.5^1030, 0.5^1040, ..., 0.5^1070 and values close above.
        -- The approximation 8651/28738 guarantees k1 < 1 + logBase 10 x
        -- for IEEE-ish floating point types with exponent fields
        -- <= 17 bits and mantissae of several thousand bits, earlier
        -- convergents to logBase 10 2 would fail for long double.
        -- Using quot instead of div is a little faster and requires
        -- fewer fixup steps for negative lx.
        let lx :: Int
lx = Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
e0
            k1 :: Int
k1 = (Int
lx Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
* Int
8651) Int -> Int -> Int
forall a. Integral a => a -> a -> a
External instance of the constraint type Integral Int
`quot` Int
28738
        in if Int
lx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
>= Int
0 then Int
k1 Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
1 else Int
k1
     else
        -- f :: Integer, log :: Float -> Float,
        --               ceiling :: Float -> Int
        Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
External instance of the constraint type Integral Int
External instance of the constraint type RealFrac Float
ceiling ((Float -> Float
forall a. Floating a => a -> a
External instance of the constraint type Floating Float
log (Integer -> Float
forall a. Num a => Integer -> a
External instance of the constraint type Num Float
fromInteger (Integer
fInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
+Integer
1) :: Float) Float -> Float -> Float
forall a. Num a => a -> a -> a
External instance of the constraint type Num Float
+
                 Int -> Float
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Float
External instance of the constraint type Integral Int
fromIntegral Int
e Float -> Float -> Float
forall a. Num a => a -> a -> a
External instance of the constraint type Num Float
* Float -> Float
forall a. Floating a => a -> a
External instance of the constraint type Floating Float
log (Integer -> Float
forall a. Num a => Integer -> a
External instance of the constraint type Num Float
fromInteger Integer
b)) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
External instance of the constraint type Fractional Float
/
                   Float -> Float
forall a. Floating a => a -> a
External instance of the constraint type Floating Float
log Float
10)
--WAS:            fromInt e * log (fromInteger b))

    fixup :: Int -> Int
fixup Int
n =
      if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
>= Int
0 then
        if Integer
r Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
+ Integer
mUp Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Integer
<= Integer -> Int -> Integer
expt Integer
10 Int
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
* Integer
s then Int
n else Int -> Int
fixup (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+Int
1)
      else
        if Integer -> Int -> Integer
expt Integer
10 (-Int
n) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
* (Integer
r Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
+ Integer
mUp) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Integer
<= Integer
s then Int
n else Int -> Int
fixup (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+Int
1)
   in
   Int -> Int
fixup Int
k0

  gen :: [t] -> t -> t -> t -> t -> [t]
gen [t]
ds t
rn t
sN t
mUpN t
mDnN =
   let
    (t
dn, t
rn') = (t
rn t -> t -> t
forall a. Num a => a -> a -> a
External instance of the constraint type forall a. Real a => Num a
External instance of the constraint type forall a. Integral a => Real a
Evidence bound by a type signature of the constraint type Integral t
* t
10) t -> t -> (t, t)
forall a. Integral a => a -> a -> (a, a)
Evidence bound by a type signature of the constraint type Integral t
`quotRem` t
sN
    mUpN' :: t
mUpN' = t
mUpN t -> t -> t
forall a. Num a => a -> a -> a
External instance of the constraint type forall a. Real a => Num a
External instance of the constraint type forall a. Integral a => Real a
Evidence bound by a type signature of the constraint type Integral t
* t
10
    mDnN' :: t
mDnN' = t
mDnN t -> t -> t
forall a. Num a => a -> a -> a
External instance of the constraint type forall a. Real a => Num a
External instance of the constraint type forall a. Integral a => Real a
Evidence bound by a type signature of the constraint type Integral t
* t
10
   in
   case (t
rn' t -> t -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type forall a. Real a => Ord a
External instance of the constraint type forall a. Integral a => Real a
Evidence bound by a type signature of the constraint type Integral t
< t
mDnN', t
rn' t -> t -> t
forall a. Num a => a -> a -> a
External instance of the constraint type forall a. Real a => Num a
External instance of the constraint type forall a. Integral a => Real a
Evidence bound by a type signature of the constraint type Integral t
+ t
mUpN' t -> t -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type forall a. Real a => Ord a
External instance of the constraint type forall a. Integral a => Real a
Evidence bound by a type signature of the constraint type Integral t
> t
sN) of
    (Bool
True,  Bool
False) -> t
dn t -> [t] -> [t]
forall a. a -> [a] -> [a]
: [t]
ds
    (Bool
False, Bool
True)  -> t
dnt -> t -> t
forall a. Num a => a -> a -> a
External instance of the constraint type forall a. Real a => Num a
External instance of the constraint type forall a. Integral a => Real a
Evidence bound by a type signature of the constraint type Integral t
+t
1 t -> [t] -> [t]
forall a. a -> [a] -> [a]
: [t]
ds
    (Bool
True,  Bool
True)  -> if t
rn' t -> t -> t
forall a. Num a => a -> a -> a
External instance of the constraint type forall a. Real a => Num a
External instance of the constraint type forall a. Integral a => Real a
Evidence bound by a type signature of the constraint type Integral t
* t
2 t -> t -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type forall a. Real a => Ord a
External instance of the constraint type forall a. Integral a => Real a
Evidence bound by a type signature of the constraint type Integral t
< t
sN then t
dn t -> [t] -> [t]
forall a. a -> [a] -> [a]
: [t]
ds else t
dnt -> t -> t
forall a. Num a => a -> a -> a
External instance of the constraint type forall a. Real a => Num a
External instance of the constraint type forall a. Integral a => Real a
Evidence bound by a type signature of the constraint type Integral t
+t
1 t -> [t] -> [t]
forall a. a -> [a] -> [a]
: [t]
ds
    (Bool
False, Bool
False) -> [t] -> t -> t -> t -> t -> [t]
gen (t
dnt -> [t] -> [t]
forall a. a -> [a] -> [a]
:[t]
ds) t
rn' t
sN t
mUpN' t
mDnN'

  rds :: [Integer]
rds =
   if Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
>= Int
0 then
      [Integer] -> Integer -> Integer -> Integer -> Integer -> [Integer]
forall {t}. Integral t => [t] -> t -> t -> t -> t -> [t]
External instance of the constraint type Integral Integer
gen [] Integer
r (Integer
s Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
* Integer -> Int -> Integer
expt Integer
10 Int
k) Integer
mUp Integer
mDn
   else
     let bk :: Integer
bk = Integer -> Int -> Integer
expt Integer
10 (-Int
k) in
     [Integer] -> Integer -> Integer -> Integer -> Integer -> [Integer]
forall {t}. Integral t => [t] -> t -> t -> t -> t -> [t]
External instance of the constraint type Integral Integer
gen [] (Integer
r Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
* Integer
bk) Integer
s (Integer
mUp Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
* Integer
bk) (Integer
mDn Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
* Integer
bk)
 in
 ((Integer -> Int) -> [Integer] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> Int
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Int
External instance of the constraint type Integral Integer
fromIntegral ([Integer] -> [Integer]
forall a. [a] -> [a]
reverse [Integer]
rds), Int
k)

-- Exponentiation with a cache for the most common numbers.
minExpt, maxExpt :: Int
minExpt :: Int
minExpt = Int
0
maxExpt :: Int
maxExpt = Int
1100

expt :: Integer -> Int -> Integer
expt :: Integer -> Int -> Integer
expt Integer
base Int
n
    | Integer
base Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Integer
== Integer
2 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
>= Int
minExpt Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
<= Int
maxExpt = Array Int Integer
expts Array Int Integer -> Int -> Integer
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
External instance of the constraint type Ix Int
External instance of the constraint type forall e. IArray Array e
`unsafeAt` Int
n
    | Integer
base Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Integer
== Integer
10 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
<= Int
maxExpt10              = Array Int Integer
expts10 Array Int Integer -> Int -> Integer
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
External instance of the constraint type Ix Int
External instance of the constraint type forall e. IArray Array e
`unsafeAt` Int
n
    | Bool
otherwise                                 = Integer
baseInteger -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
External instance of the constraint type Integral Int
External instance of the constraint type Num Integer
^Int
n

expts :: Array Int Integer
expts :: Array Int Integer
expts = (Int, Int) -> [(Int, Integer)] -> Array Int Integer
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [(i, e)] -> a i e
External instance of the constraint type Ix Int
External instance of the constraint type forall e. IArray Array e
array (Int
minExpt,Int
maxExpt) [(Int
n,Integer
2Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
External instance of the constraint type Integral Int
External instance of the constraint type Num Integer
^Int
n) | Int
n <- [Int
minExpt .. Int
maxExpt]]

maxExpt10 :: Int
maxExpt10 :: Int
maxExpt10 = Int
324

expts10 :: Array Int Integer
expts10 :: Array Int Integer
expts10 = (Int, Int) -> [(Int, Integer)] -> Array Int Integer
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [(i, e)] -> a i e
External instance of the constraint type Ix Int
External instance of the constraint type forall e. IArray Array e
array (Int
minExpt,Int
maxExpt10) [(Int
n,Integer
10Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
External instance of the constraint type Integral Int
External instance of the constraint type Num Integer
^Int
n) | Int
n <- [Int
minExpt .. Int
maxExpt10]]