{-# LANGUAGE CPP               #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell   #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-|
Module:      TextShow.Data.Floating
Copyright:   (C) 2014-2017 Ryan Scott
License:     BSD-style (see the file LICENSE)
Maintainer:  Ryan Scott
Stability:   Provisional
Portability: GHC

'TextShow' instances and monomorphic functions for floating-point types.

/Since: 2/
-}
module TextShow.Data.Floating (
      showbRealFloatPrec
    , showbEFloat
    , showbFFloat
    , showbGFloat
    , showbFFloatAlt
    , showbGFloatAlt
    , showbFPFormat
    , FPFormat(..)
    , formatRealFloatB
    , formatRealFloatAltB
    ) where

import           Data.Array.Base (unsafeAt)
import           Data.Array.IArray (Array, array)
import qualified Data.Text as T (replicate)
import           Data.Text.Lazy.Builder (Builder, fromString, fromText, singleton)
import           Data.Text.Lazy.Builder.Int (decimal)
import           Data.Text.Lazy.Builder.RealFloat (FPFormat(..))

import           Prelude ()
import           Prelude.Compat

import           TextShow.Classes (TextShow(..), showbParen)
import           TextShow.TH.Internal (deriveTextShow)
import           TextShow.Utils (i2d)

-------------------------------------------------------------------------------
-- TextShow instances
-------------------------------------------------------------------------------

-- | /Since: 2/
$(deriveTextShow ''FPFormat)

-- | /Since: 2/
instance TextShow Float where
    showbPrec :: Int -> Float -> Builder
showbPrec = forall a. RealFloat a => Int -> a -> Builder
showbRealFloatPrec
    {-# INLINE showbPrec #-}

-- | /Since: 2/
instance TextShow Double where
    showbPrec :: Int -> Double -> Builder
showbPrec = forall a. RealFloat a => Int -> a -> Builder
showbRealFloatPrec
    {-# INLINE showbPrec #-}

-------------------------------------------------------------------------------
-- Standalone showb* functions
-------------------------------------------------------------------------------

-- | Convert a 'RealFloat' value to a 'Builder' with the given precedence.
--
-- /Since: 2/
showbRealFloatPrec :: RealFloat a => Int -> a -> Builder
showbRealFloatPrec :: forall a. RealFloat a => Int -> a -> Builder
showbRealFloatPrec Int
p a
x
    | a
x forall a. Ord a => a -> a -> Bool
< a
0 Bool -> Bool -> Bool
|| forall a. RealFloat a => a -> Bool
isNegativeZero a
x = Bool -> Builder -> Builder
showbParen (Int
p forall a. Ord a => a -> a -> Bool
> Int
6) forall a b. (a -> b) -> a -> b
$ Char -> Builder
singleton Char
'-' forall a. Semigroup a => a -> a -> a
<> forall a. RealFloat a => Maybe Int -> a -> Builder
showbGFloat forall a. Maybe a
Nothing (-a
x)
    | Bool
otherwise                 = forall a. RealFloat a => Maybe Int -> a -> Builder
showbGFloat forall a. Maybe a
Nothing a
x
{-# INLINE showbRealFloatPrec #-}

{-# SPECIALIZE showbEFloat ::
        Maybe Int -> Float  -> Builder,
        Maybe Int -> Double -> Builder #-}
{-# SPECIALIZE showbFFloat ::
        Maybe Int -> Float  -> Builder,
        Maybe Int -> Double -> Builder #-}
{-# SPECIALIZE showbGFloat ::
        Maybe Int -> Float  -> Builder,
        Maybe Int -> Double -> Builder #-}

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

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

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

-- | Show a signed 'RealFloat' value
-- using standard decimal notation (e.g. @245000@, @0.0015@).
--
-- This behaves as 'showFFloat', except that a decimal point
-- is always guaranteed, even if not needed.
--
-- /Since: 2/
showbFFloatAlt :: RealFloat a => Maybe Int -> a -> Builder
showbFFloatAlt :: forall a. RealFloat a => Maybe Int -> a -> Builder
showbFFloatAlt Maybe Int
d = forall a.
RealFloat a =>
FPFormat -> Maybe Int -> Bool -> a -> Builder
formatRealFloatAltB FPFormat
Fixed Maybe Int
d Bool
True
{-# INLINE showbFFloatAlt #-}

-- | Show a signed 'RealFloat' value
-- using standard decimal notation for arguments whose absolute value lies
-- between @0.1@ and @9,999,999@, and scientific notation otherwise.
--
-- This behaves as 'showFFloat', except that a decimal point
-- is always guaranteed, even if not needed.
--
-- /Since: 2/
showbGFloatAlt :: RealFloat a => Maybe Int -> a -> Builder
showbGFloatAlt :: forall a. RealFloat a => Maybe Int -> a -> Builder
showbGFloatAlt Maybe Int
d = forall a.
RealFloat a =>
FPFormat -> Maybe Int -> Bool -> a -> Builder
formatRealFloatAltB FPFormat
Generic Maybe Int
d Bool
True
{-# INLINE showbGFloatAlt #-}

-- | Convert an 'FPFormat' value to a 'Builder'.
--
-- /Since: 2/
showbFPFormat :: FPFormat -> Builder
showbFPFormat :: FPFormat -> Builder
showbFPFormat = forall a. TextShow a => a -> Builder
showb
{-# INLINE showbFPFormat #-}

-------------------------------------------------------------------------------
-- GHC.Float internal functions, adapted for Builders
-------------------------------------------------------------------------------

-- | Like 'formatRealFloatAltB', except that the decimal is only shown for arguments
-- whose absolute value is between @0.1@ and @9,999,999@.
--
-- /Since: 2/
formatRealFloatB :: RealFloat a
                 => FPFormat  -- ^ What notation to use.
                 -> Maybe Int -- ^ Number of decimal places to render.
                 -> a
                 -> Builder
formatRealFloatB :: forall a. RealFloat a => FPFormat -> Maybe Int -> a -> Builder
formatRealFloatB FPFormat
fmt Maybe Int
decs = forall a.
RealFloat a =>
FPFormat -> Maybe Int -> Bool -> a -> Builder
formatRealFloatAltB FPFormat
fmt Maybe Int
decs Bool
False
{-# INLINE formatRealFloatB #-}

-- | Converts a 'RealFloat' value to a Builder, specifying if a decimal point
-- should always be shown.
--
-- /Since: 2/
formatRealFloatAltB :: RealFloat a
                    => FPFormat  -- ^ What notation to use.
                    -> Maybe Int -- ^ Number of decimal places to render.
                    -> Bool      -- ^ Should a decimal point always be shown?
                    -> a
                    -> Builder
{-# SPECIALIZE formatRealFloatAltB :: FPFormat -> Maybe Int -> Bool -> Float  -> Builder #-}
{-# SPECIALIZE formatRealFloatAltB :: FPFormat -> Maybe Int -> Bool -> Double -> Builder #-}
formatRealFloatAltB :: forall a.
RealFloat a =>
FPFormat -> Maybe Int -> Bool -> a -> Builder
formatRealFloatAltB FPFormat
fmt Maybe Int
decs Bool
alt a
x
   | forall a. RealFloat a => a -> Bool
isNaN a
x                   = Builder
"NaN"
   | forall a. RealFloat a => a -> Bool
isInfinite a
x              = if a
x forall a. Ord a => a -> a -> Bool
< a
0 then Builder
"-Infinity" else Builder
"Infinity"
   | a
x forall a. Ord a => a -> a -> Bool
< a
0 Bool -> Bool -> Bool
|| forall a. RealFloat a => a -> Bool
isNegativeZero a
x = Char -> Builder
singleton Char
'-' forall a. Semigroup a => a -> a -> a
<> FPFormat -> ([Int], Int) -> Builder
doFmt FPFormat
fmt (forall a. RealFloat a => a -> ([Int], Int)
floatToDigits (-a
x))
   | Bool
otherwise                 = FPFormat -> ([Int], Int) -> Builder
doFmt FPFormat
fmt (forall a. RealFloat a => a -> ([Int], Int)
floatToDigits a
x)
 where
  doFmt :: FPFormat -> ([Int], Int) -> Builder
doFmt FPFormat
format ([Int]
is, Int
e) =
    let ds :: String
ds = 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 forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
e forall a. Ord a => a -> a -> Bool
> 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' = forall a. Integral a => a -> Builder
decimal (Int
eforall a. Num a => a -> a -> a
-Int
1) in
        case String
ds of
          String
"0"     -> Builder
"0.0e0"
          [Char
d]     -> Char -> Builder
singleton Char
d forall a. Semigroup a => a -> a -> a
<> Builder
".0e" forall a. Semigroup a => a -> a -> a
<> Builder
show_e'
          (Char
d:String
ds') -> Char -> Builder
singleton Char
d forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
'.' forall a. Semigroup a => a -> a -> a
<> String -> Builder
fromString String
ds' forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
'e' forall a. Semigroup a => a -> a -> a
<> Builder
show_e'
          []      -> forall a. HasCallStack => String -> a
error String
"formatRealFloat/doFmt/Exponent: []"
       Just Int
d | Int
d forall a. Ord a => a -> a -> Bool
<= Int
0 ->
        -- handle this case specifically since we need to omit the
        -- decimal point as well (#15115).
        -- Note that this handles negative precisions as well for consistency
        -- (see #15509).
        case [Int]
is of
          [Int
0] -> Builder
"0e0"
          [Int]
_ ->
           let
             (Int
ei,[Int]
is') = Int -> [Int] -> (Int, [Int])
roundTo Int
1 [Int]
is
             n :: Char
n = case forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
i2d (if Int
ei forall a. Ord a => a -> a -> Bool
> Int
0 then forall a. [a] -> [a]
init [Int]
is' else [Int]
is') of
                   Char
n':String
_ -> Char
n'
                   []   -> forall a. HasCallStack => String -> a
error String
"formatRealFloatAltB (Exponent, negative decs): Unexpected empty list"
           in Char -> Builder
singleton Char
n forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
'e' forall a. Semigroup a => a -> a -> a
<> forall a. Integral a => a -> Builder
decimal (Int
eforall a. Num a => a -> a -> a
-Int
1forall a. Num a => a -> a -> a
+Int
ei)
       Just Int
dec ->
        let dec' :: Int
dec' = forall a. Ord a => a -> a -> a
max Int
dec Int
1 in
        case [Int]
is of
         [Int
0] -> Builder
"0." forall a. Semigroup a => a -> a -> a
<> Text -> Builder
fromText (Int -> Text -> Text
T.replicate Int
dec' Text
"0") forall a. Semigroup a => a -> a -> a
<> Builder
"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,String
ds') = case forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
i2d (if Int
ei forall a. Ord a => a -> a -> Bool
> Int
0 then forall a. [a] -> [a]
init [Int]
is' else [Int]
is') of
                       (Char
d':String
ds'') -> (Char
d',String
ds'')
                       []        -> forall a. HasCallStack => String -> a
error String
"formatRealFloatAltB (Exponent, non-negative decs): Unexpected empty list"
          in
          Char -> Builder
singleton Char
d forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
'.' forall a. Semigroup a => a -> a -> a
<> String -> Builder
fromString String
ds' forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
'e' forall a. Semigroup a => a -> a -> a
<> forall a. Integral a => a -> Builder
decimal (Int
eforall a. Num a => a -> a -> a
-Int
1forall a. Num a => a -> a -> a
+Int
ei)
     FPFormat
Fixed ->
      let
       mk0 :: String -> Builder
mk0 String
ls = case String
ls of { String
"" -> Builder
"0" ; String
_ -> String -> Builder
fromString String
ls}
      in
      case Maybe Int
decs of
       Maybe Int
Nothing
          | Int
e forall a. Ord a => a -> a -> Bool
<= Int
0    -> Builder
"0." forall a. Semigroup a => a -> a -> a
<> Text -> Builder
fromText (Int -> Text -> Text
T.replicate (-Int
e) Text
"0") forall a. Semigroup a => a -> a -> a
<> String -> Builder
fromString String
ds
          | Bool
otherwise ->
             let
                f :: t -> String -> String -> Builder
f t
0 String
str    String
rs  = String -> Builder
mk0 (forall a. [a] -> [a]
reverse String
str) forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
'.' forall a. Semigroup a => a -> a -> a
<> String -> Builder
mk0 String
rs
                f t
n String
str    String
""  = t -> String -> String -> Builder
f (t
nforall a. Num a => a -> a -> a
-t
1) (Char
'0'forall a. a -> [a] -> [a]
:String
str) String
""
                f t
n String
str (Char
r:String
rs) = t -> String -> String -> Builder
f (t
nforall a. Num a => a -> a -> a
-t
1) (Char
rforall a. a -> [a] -> [a]
:String
str) String
rs
             in
                forall {t}. (Eq t, Num t) => t -> String -> String -> Builder
f Int
e String
"" String
ds
       Just Int
dec ->
        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
          (String
ls,String
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
i2d [Int]
is')
         in
         String -> Builder
mk0 String
ls forall a. Semigroup a => a -> a -> a
<> (if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rs Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
alt then Builder
"" else Char -> Builder
singleton Char
'.' forall a. Semigroup a => a -> a -> a
<> String -> Builder
fromString String
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,String
ds') = case forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
i2d (if Int
ei forall a. Ord a => a -> a -> Bool
> Int
0 then [Int]
is' else Int
0forall a. a -> [a] -> [a]
:[Int]
is') of
                      (Char
d':String
ds'') -> (Char
d',String
ds'')
                      []        -> forall a. HasCallStack => String -> a
error String
"formatRealFloatAltB (Fixed): Unexpected empty list"
         in
         Char -> Builder
singleton Char
d forall a. Semigroup a => a -> a -> a
<> (if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
ds' Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
alt then Builder
"" else Char -> Builder
singleton Char
'.' forall a. Semigroup a => a -> a -> a
<> String -> Builder
fromString String
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 :: forall a. RealFloat a => a -> ([Int], Int)
floatToDigits a
0 = ([Int
0], Int
0)
floatToDigits a
x =
 let
  (Integer
f0, Int
e0) = forall a. RealFloat a => a -> (Integer, Int)
decodeFloat a
x
  (Int
minExp0, Int
_) = forall a. RealFloat a => a -> (Int, Int)
floatRange a
x
  p :: Int
p = forall a. RealFloat a => a -> Int
floatDigits a
x
  b :: Integer
b = forall a. RealFloat a => a -> Integer
floatRadix a
x
  minExp :: Int
minExp = Int
minExp0 forall a. Num a => a -> a -> a
- 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 forall a. Num a => a -> a -> a
- Int
e0 in
   if Int
n forall a. Ord a => a -> a -> Bool
> Int
0 then (Integer
f0 forall a. Integral a => a -> a -> a
`quot` (Integer -> Int -> Integer
expt Integer
b Int
n), Int
e0forall a. Num a => a -> a -> a
+Int
n) else (Integer
f0, Int
e0)
  (Integer
r, Integer
s', Integer
mUp, Integer
mDn) =
   if Int
e forall a. Ord a => a -> a -> Bool
>= Int
0 then
    let be :: Integer
be = Integer -> Int -> Integer
expt Integer
b Int
e in
    if Integer
f forall a. Eq a => a -> a -> Bool
== Integer -> Int -> Integer
expt Integer
b (Int
pforall a. Num a => a -> a -> a
-Int
1) then
      (Integer
fforall a. Num a => a -> a -> a
*Integer
beforall a. Num a => a -> a -> a
*Integer
bforall a. Num a => a -> a -> a
*Integer
2, Integer
2forall a. Num a => a -> a -> a
*Integer
b, Integer
beforall a. Num a => a -> a -> a
*Integer
b, Integer
be)     -- according to Burger and Dybvig
    else
      (Integer
fforall a. Num a => a -> a -> a
*Integer
beforall a. Num a => a -> a -> a
*Integer
2, Integer
2, Integer
be, Integer
be)
   else
    if Int
e forall a. Ord a => a -> a -> Bool
> Int
minExp Bool -> Bool -> Bool
&& Integer
f forall a. Eq a => a -> a -> Bool
== Integer -> Int -> Integer
expt Integer
b (Int
pforall a. Num a => a -> a -> a
-Int
1) then
      (Integer
fforall a. Num a => a -> a -> a
*Integer
bforall a. Num a => a -> a -> a
*Integer
2, Integer -> Int -> Integer
expt Integer
b (-Int
eforall a. Num a => a -> a -> a
+Int
1)forall a. Num a => a -> a -> a
*Integer
2, Integer
b, Integer
1)
    else
      (Integer
fforall a. Num a => a -> a -> a
*Integer
2, Integer -> Int -> Integer
expt Integer
b (-Int
e)forall a. Num a => a -> a -> a
*Integer
2, Integer
1, Integer
1)
  k :: Int
  k :: Int
k =
   let
    k0 :: Int
    k0 :: Int
k0 =
     if Integer
b forall a. Eq a => a -> a -> Bool
== 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 forall a. Num a => a -> a -> a
- Int
1 forall a. Num a => a -> a -> a
+ Int
e0
            k1 :: Int
k1 = (Int
lx forall a. Num a => a -> a -> a
* Int
8651) forall a. Integral a => a -> a -> a
`quot` Int
28738
        in if Int
lx forall a. Ord a => a -> a -> Bool
>= Int
0 then Int
k1 forall a. Num a => a -> a -> a
+ Int
1 else Int
k1
     else
        -- f :: Integer, log :: Float -> Float,
        --               ceiling :: Float -> Int
        forall a b. (RealFrac a, Integral b) => a -> b
ceiling ((forall a. Floating a => a -> a
log (forall a. Num a => Integer -> a
fromInteger (Integer
fforall a. Num a => a -> a -> a
+Integer
1) :: Float) forall a. Num a => a -> a -> a
+
                 forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
e forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
log (forall a. Num a => Integer -> a
fromInteger Integer
b)) forall a. Fractional a => a -> a -> a
/
                   forall a. Floating a => a -> a
log Float
10)
--WAS:            fromInt e * log (fromInteger b))

    fixup :: Int -> Int
fixup Int
n =
      if Int
n forall a. Ord a => a -> a -> Bool
>= Int
0 then
        if Integer
r forall a. Num a => a -> a -> a
+ Integer
mUp forall a. Ord a => a -> a -> Bool
<= Integer -> Int -> Integer
expt Integer
10 Int
n forall a. Num a => a -> a -> a
* Integer
s' then Int
n else Int -> Int
fixup (Int
nforall a. Num a => a -> a -> a
+Int
1)
      else
        if Integer -> Int -> Integer
expt Integer
10 (-Int
n) forall a. Num a => a -> a -> a
* (Integer
r forall a. Num a => a -> a -> a
+ Integer
mUp) forall a. Ord a => a -> a -> Bool
<= Integer
s' then Int
n else Int -> Int
fixup (Int
nforall a. Num a => a -> a -> a
+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 forall a. Num a => a -> a -> a
* t
10) forall a. Integral a => a -> a -> (a, a)
`quotRem` t
sN
    mUpN' :: t
mUpN' = t
mUpN forall a. Num a => a -> a -> a
* t
10
    mDnN' :: t
mDnN' = t
mDnN forall a. Num a => a -> a -> a
* t
10
   in
   case (t
rn' forall a. Ord a => a -> a -> Bool
< t
mDnN', t
rn' forall a. Num a => a -> a -> a
+ t
mUpN' forall a. Ord a => a -> a -> Bool
> t
sN) of
    (Bool
True,  Bool
False) -> t
dn forall a. a -> [a] -> [a]
: [t]
ds
    (Bool
False, Bool
True)  -> t
dnforall a. Num a => a -> a -> a
+t
1 forall a. a -> [a] -> [a]
: [t]
ds
    (Bool
True,  Bool
True)  -> if t
rn' forall a. Num a => a -> a -> a
* t
2 forall a. Ord a => a -> a -> Bool
< t
sN then t
dn forall a. a -> [a] -> [a]
: [t]
ds else t
dnforall a. Num a => a -> a -> a
+t
1 forall a. a -> [a] -> [a]
: [t]
ds
    (Bool
False, Bool
False) -> [t] -> t -> t -> t -> t -> [t]
gen (t
dnforall a. a -> [a] -> [a]
:[t]
ds) t
rn' t
sN t
mUpN' t
mDnN'

  rds :: [Integer]
rds =
   if Int
k forall a. Ord a => a -> a -> Bool
>= Int
0 then
      forall {t}. Integral t => [t] -> t -> t -> t -> t -> [t]
gen [] Integer
r (Integer
s' forall a. Num a => a -> a -> a
* 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
     forall {t}. Integral t => [t] -> t -> t -> t -> t -> [t]
gen [] (Integer
r forall a. Num a => a -> a -> a
* Integer
bk) Integer
s' (Integer
mUp forall a. Num a => a -> a -> a
* Integer
bk) (Integer
mDn forall a. Num a => a -> a -> a
* Integer
bk)
 in
 (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. [a] -> [a]
reverse [Integer]
rds), Int
k)

roundTo :: Int -> [Int] -> (Int,[Int])
roundTo :: Int -> [Int] -> (Int, [Int])
roundTo Int
d [Int]
is =
  case Int -> Bool -> [Int] -> (Int, [Int])
f Int
d Bool
True [Int]
is of
    x :: (Int, [Int])
x@(Int
0,[Int]
_) -> (Int, [Int])
x
    (Int
1,[Int]
xs)  -> (Int
1, Int
1forall a. a -> [a] -> [a]
:[Int]
xs)
    (Int, [Int])
_       -> forall a. HasCallStack => String -> a
error String
"roundTo: bad Value"
 where
  b2 :: Int
b2 = Int
base forall a. Integral a => a -> a -> a
`quot` Int
2

  f :: Int -> Bool -> [Int] -> (Int, [Int])
f Int
n Bool
_ []     = (Int
0, forall a. Int -> a -> [a]
replicate Int
n Int
0)
  f Int
0 Bool
e (Int
x:[Int]
xs) | Int
x forall a. Eq a => a -> a -> Bool
== Int
b2 Bool -> Bool -> Bool
&& Bool
e Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Eq a => a -> a -> Bool
== Int
0) [Int]
xs = (Int
0, [])   -- Round to even when at exactly half the base
               | Bool
otherwise = (if Int
x forall a. Ord a => a -> a -> Bool
>= Int
b2 then Int
1 else Int
0, [])
  f Int
n Bool
_ (Int
i:[Int]
xs)
     | Int
i' forall a. Eq a => a -> a -> Bool
== Int
base = (Int
1,Int
0forall a. a -> [a] -> [a]
:[Int]
ds)
     | Bool
otherwise  = (Int
0,Int
i'forall a. a -> [a] -> [a]
:[Int]
ds)
      where
       (Int
c,[Int]
ds) = Int -> Bool -> [Int] -> (Int, [Int])
f (Int
nforall a. Num a => a -> a -> a
-Int
1) (forall a. Integral a => a -> Bool
even Int
i) [Int]
xs
       i' :: Int
i'     = Int
c forall a. Num a => a -> a -> a
+ Int
i
  base :: Int
base = Int
10

-- Exponentiation with a cache for the most common numbers.

-- | The minimum exponent in the cache.
minExpt :: Int
minExpt :: Int
minExpt = Int
0

-- | The maximum exponent (of 2) in the cache.
maxExpt :: Int
maxExpt :: Int
maxExpt = Int
1100

-- | Exponentiate an 'Integer', using a cache if possible.
expt :: Integer -> Int -> Integer
expt :: Integer -> Int -> Integer
expt Integer
base Int
n
    | Integer
base forall a. Eq a => a -> a -> Bool
== Integer
2 Bool -> Bool -> Bool
&& Int
n forall a. Ord a => a -> a -> Bool
>= Int
minExpt Bool -> Bool -> Bool
&& Int
n forall a. Ord a => a -> a -> Bool
<= Int
maxExpt = Array Int Integer
expts forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
`unsafeAt` Int
n
    | Integer
base forall a. Eq a => a -> a -> Bool
== Integer
10 Bool -> Bool -> Bool
&& Int
n forall a. Ord a => a -> a -> Bool
<= Int
maxExpt10              = Array Int Integer
expts10 forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
`unsafeAt` Int
n
    | Bool
otherwise                                 = Integer
baseforall a b. (Num a, Integral b) => a -> b -> a
^Int
n

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

-- | The maximum exponent (of 10) in the cache.
maxExpt10 :: Int
maxExpt10 :: Int
maxExpt10 = Int
324

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