    {-# 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 = Int -> Float -> Builder
    forall a. RealFloat a => Int -> a -> Builder
    showbRealFloatPrec
        {-# INLINE showbPrec #-}

    -- | /Since: 2/
    instance TextShow Double where
        showbPrec :: Int -> Double -> Builder
    showbPrec = Int -> Double -> Builder
    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 a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    < a
    0 Bool -> Bool -> Bool
    || a -> Bool
    forall a. RealFloat a => a -> Bool
    isNegativeZero a
    x = Bool -> Builder -> Builder
    showbParen (Int
    p Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    6) (Builder -> Builder) -> Builder -> Builder
    forall a b. (a -> b) -> a -> b
    $ Char -> Builder
    singleton Char
    '-' Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Maybe Int -> a -> Builder
    forall a. RealFloat a => Maybe Int -> a -> Builder
    showbGFloat Maybe Int
    forall a. Maybe a
    Nothing (-a
    x)
        | Bool
    otherwise                 = Maybe Int -> a -> Builder
    forall a. RealFloat a => Maybe Int -> a -> Builder
    showbGFloat Maybe Int
    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 = FPFormat -> Maybe Int -> a -> Builder
    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 = FPFormat -> Maybe Int -> a -> Builder
    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 = FPFormat -> Maybe Int -> a -> Builder
    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 = FPFormat -> Maybe Int -> Bool -> a -> Builder
    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 = FPFormat -> Maybe Int -> Bool -> a -> Builder
    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 = FPFormat -> Builder
    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 = FPFormat -> Maybe Int -> Bool -> a -> Builder
    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
       | a -> Bool
    forall a. RealFloat a => a -> Bool
    isNaN a
    x                   = Builder
    "NaN"
       | a -> Bool
    forall a. RealFloat a => a -> Bool
    isInfinite a
    x              = if a
    x a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    < a
    0 then Builder
    "-Infinity" else Builder
    "Infinity"
       | a
    x a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    < a
    0 Bool -> Bool -> Bool
    || a -> Bool
    forall a. RealFloat a => a -> Bool
    isNegativeZero a
    x = Char -> Builder
    singleton Char
    '-' Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> FPFormat -> ([Int], Int) -> Builder
    doFmt FPFormat
    fmt (a -> ([Int], Int)
    forall a. RealFloat a => a -> ([Int], Int)
    floatToDigits (-a
    x))
       | Bool
    otherwise                 = FPFormat -> ([Int], Int) -> Builder
    doFmt FPFormat
    fmt (a -> ([Int], Int)
    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 = (Int -> Char) -> [Int] -> String
    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
    < Int
    0 Bool -> Bool -> Bool
    || Int
    e Int -> Int -> Bool
    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' = Int -> Builder
    forall a. Integral a => a -> Builder
    decimal (Int
    eInt -> Int -> Int
    forall 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 Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Builder
    ".0e" Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Builder
    show_e'
              (Char
    d:String
    ds') -> Char -> Builder
    singleton Char
    d Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Char -> Builder
    singleton Char
    '.' Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> String -> Builder
    fromString String
    ds' Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Char -> Builder
    singleton Char
    'e' Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Builder
    show_e'
              []      -> String -> Builder
    forall a. HasCallStack => String -> a
    error String
    "formatRealFloat/doFmt/Exponent: []"
           Just Int
    d | Int
    d Int -> Int -> Bool
    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 (Int -> Char) -> [Int] -> String
    forall a b. (a -> b) -> [a] -> [b]
    map Int -> Char
    i2d (if Int
    ei Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0 then [Int] -> [Int]
    forall a. HasCallStack => [a] -> [a]
    init [Int]
    is' else [Int]
    is') of
                       Char
    n':String
    _ -> Char
    n'
                       []   -> String -> Char
    forall a. HasCallStack => String -> a
    error String
    "formatRealFloatAltB (Exponent, negative decs): Unexpected empty list"
               in Char -> Builder
    singleton Char
    n Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Char -> Builder
    singleton Char
    'e' Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Int -> Builder
    forall a. Integral a => a -> Builder
    decimal (Int
    eInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1Int -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    ei)
           Just Int
    dec ->
            let dec' :: Int
    dec' = Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    dec Int
    1 in
            case [Int]
    is of
             [Int
    0] -> Builder
    "0." Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Text -> Builder
    fromText (Int -> Text -> Text
    T.replicate Int
    dec' Text
    "0") Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> 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
    +Int
    1) [Int]
    is
               (Char
    d,String
    ds') = case (Int -> Char) -> [Int] -> String
    forall a b. (a -> b) -> [a] -> [b]
    map Int -> Char
    i2d (if Int
    ei Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0 then [Int] -> [Int]
    forall a. HasCallStack => [a] -> [a]
    init [Int]
    is' else [Int]
    is') of
                           (Char
    d':String
    ds'') -> (Char
    d',String
    ds'')
                           []        -> String -> (Char, String)
    forall a. HasCallStack => String -> a
    error String
    "formatRealFloatAltB (Exponent, non-negative decs): Unexpected empty list"
              in
              Char -> Builder
    singleton Char
    d Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Char -> Builder
    singleton Char
    '.' Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> String -> Builder
    fromString String
    ds' Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Char -> Builder
    singleton Char
    'e' Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Int -> Builder
    forall a. Integral a => a -> Builder
    decimal (Int
    eInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1Int -> Int -> Int
    forall 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 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    0    -> Builder
    "0." Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Text -> Builder
    fromText (Int -> Text -> Text
    T.replicate (-Int
    e) Text
    "0") Builder -> Builder -> Builder
    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 (String -> String
    forall a. [a] -> [a]
    reverse String
    str) Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Char -> Builder
    singleton Char
    '.' Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> String -> Builder
    mk0 String
    rs
                    f t
    n String
    str    String
    ""  = t -> String -> String -> Builder
    f (t
    nt -> t -> t
    forall a. Num a => a -> a -> a
    -t
    1) (Char
    '0'Char -> String -> String
    forall a. a -> [a] -> [a]
    :String
    str) String
    ""
                    f t
    n String
    str (Char
    r:String
    rs) = t -> String -> String -> Builder
    f (t
    nt -> t -> t
    forall a. Num a => a -> a -> a
    -t
    1) (Char
    rChar -> String -> String
    forall a. a -> [a] -> [a]
    :String
    str) String
    rs
                 in
                    Int -> String -> String -> Builder
    forall {t}. (Eq t, Num t) => t -> String -> String -> Builder
    f Int
    e String
    "" String
    ds
           Just Int
    dec ->
            let dec' :: Int
    dec' = Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    dec Int
    0 in
            if Int
    e Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= 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
    + Int
    e) [Int]
    is
              (String
    ls,String
    rs)  = Int -> String -> (String, String)
    forall a. Int -> [a] -> ([a], [a])
    splitAt (Int
    eInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    ei) ((Int -> Char) -> [Int] -> String
    forall a b. (a -> b) -> [a] -> [b]
    map Int -> Char
    i2d [Int]
    is')
             in
             String -> Builder
    mk0 String
    ls Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> (if String -> Bool
    forall a. [a] -> Bool
    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
    '.' Builder -> Builder -> Builder
    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' (Int -> Int -> [Int]
    forall a. Int -> a -> [a]
    replicate (-Int
    e) Int
    0 [Int] -> [Int] -> [Int]
    forall a. [a] -> [a] -> [a]
    ++ [Int]
    is)
              (Char
    d,String
    ds') = case (Int -> Char) -> [Int] -> String
    forall a b. (a -> b) -> [a] -> [b]
    map Int -> Char
    i2d (if Int
    ei Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0 then [Int]
    is' else Int
    0Int -> [Int] -> [Int]
    forall a. a -> [a] -> [a]
    :[Int]
    is') of
                          (Char
    d':String
    ds'') -> (Char
    d',String
    ds'')
                          []        -> String -> (Char, String)
    forall a. HasCallStack => String -> a
    error String
    "formatRealFloatAltB (Fixed): Unexpected empty list"
             in
             Char -> Builder
    singleton Char
    d Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> (if String -> Bool
    forall a. [a] -> Bool
    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
    '.' Builder -> Builder -> Builder
    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) = a -> (Integer, Int)
    forall a. RealFloat a => a -> (Integer, Int)
    decodeFloat a
    x
      (Int
    minExp0, Int
    _) = a -> (Int, Int)
    forall a. RealFloat a => a -> (Int, Int)
    floatRange a
    x
      p :: Int
    p = a -> Int
    forall a. RealFloat a => a -> Int
    floatDigits a
    x
      b :: Integer
    b = a -> Integer
    forall a. RealFloat a => a -> Integer
    floatRadix a
    x
      minExp :: Int
    minExp = Int
    minExp0 Int -> Int -> Int
    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 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    e0 in
       if Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0 then (Integer
    f0 Integer -> Integer -> Integer
    forall a. Integral a => a -> a -> a
    `quot` (Integer -> Int -> Integer
    expt Integer
    b Int
    n), Int
    e0Int -> Int -> Int
    forall a. Num a => a -> a -> a
    +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
    >= 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
    == Integer -> Int -> Integer
    expt Integer
    b (Int
    pInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1) then
          (Integer
    fInteger -> Integer -> Integer
    forall a. Num a => a -> a -> a
    *Integer
    beInteger -> Integer -> Integer
    forall a. Num a => a -> a -> a
    *Integer
    bInteger -> Integer -> Integer
    forall a. Num a => a -> a -> a
    *Integer
    2, Integer
    2Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    *Integer
    b, Integer
    beInteger -> Integer -> Integer
    forall a. Num a => a -> a -> a
    *Integer
    b, Integer
    be)     -- according to Burger and Dybvig
        else
          (Integer
    fInteger -> Integer -> Integer
    forall a. Num a => a -> a -> a
    *Integer
    beInteger -> Integer -> Integer
    forall a. Num a => a -> a -> a
    *Integer
    2, Integer
    2, Integer
    be, Integer
    be)
       else
        if Int
    e Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    minExp Bool -> Bool -> Bool
    && Integer
    f Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    == Integer -> Int -> Integer
    expt Integer
    b (Int
    pInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1) then
          (Integer
    fInteger -> Integer -> Integer
    forall a. Num a => a -> a -> a
    *Integer
    bInteger -> Integer -> Integer
    forall a. Num a => a -> a -> a
    *Integer
    2, Integer -> Int -> Integer
    expt Integer
    b (-Int
    eInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1)Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    *Integer
    2, Integer
    b, Integer
    1)
        else
          (Integer
    fInteger -> Integer -> Integer
    forall a. Num a => a -> a -> a
    *Integer
    2, Integer -> Int -> Integer
    expt Integer
    b (-Int
    e)Integer -> Integer -> Integer
    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 Integer -> Integer -> Bool
    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 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    e0
                k1 :: Int
    k1 = (Int
    lx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    8651) Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `quot` Int
    28738
            in if Int
    lx Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    0 then Int
    k1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1 else Int
    k1
         else
            -- f :: Integer, log :: Float -> Float,
            --               ceiling :: Float -> Int
            Float -> Int
    forall b. Integral b => Float -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    ceiling ((Float -> Float
    forall a. Floating a => a -> a
    log (Integer -> Float
    forall a. Num a => Integer -> a
    fromInteger (Integer
    fInteger -> Integer -> Integer
    forall a. Num a => a -> a -> a
    +Integer
    1) :: Float) Float -> Float -> Float
    forall a. Num a => a -> a -> a
    +
                     Int -> Float
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    e Float -> Float -> Float
    forall a. Num a => a -> a -> a
    * Float -> Float
    forall a. Floating a => a -> a
    log (Integer -> Float
    forall a. Num a => Integer -> a
    fromInteger Integer
    b)) Float -> Float -> Float
    forall a. Fractional a => a -> a -> a
    /
                       Float -> Float
    forall a. Floating a => a -> a
    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
    >= Int
    0 then
            if Integer
    r Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    + Integer
    mUp Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Integer -> Int -> Integer
    expt Integer
    10 Int
    n Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    * Integer
    s' then Int
    n else Int -> Int
    fixup (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1)
          else
            if Integer -> Int -> Integer
    expt Integer
    10 (-Int
    n) Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    * (Integer
    r Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    + Integer
    mUp) Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Integer
    s' then Int
    n else Int -> Int
    fixup (Int
    nInt -> Int -> Int
    forall 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 t -> t -> t
    forall a. Num a => a -> a -> a
    * t
    10) t -> t -> (t, t)
    forall a. Integral a => a -> a -> (a, a)
    `quotRem` t
    sN
        mUpN' :: t
    mUpN' = t
    mUpN t -> t -> t
    forall a. Num a => a -> a -> a
    * t
    10
        mDnN' :: t
    mDnN' = t
    mDnN t -> t -> t
    forall a. Num a => a -> a -> a
    * t
    10
       in
       case (t
    rn' t -> t -> Bool
    forall a. Ord a => a -> a -> Bool
    < t
    mDnN', t
    rn' t -> t -> t
    forall a. Num a => a -> a -> a
    + t
    mUpN' t -> t -> Bool
    forall a. Ord a => a -> a -> Bool
    > 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
    +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
    * t
    2 t -> t -> Bool
    forall a. Ord a => a -> a -> Bool
    < 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
    +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
    >= Int
    0 then
          [Integer] -> Integer -> Integer -> Integer -> Integer -> [Integer]
    forall {t}. Integral t => [t] -> t -> t -> t -> t -> [t]
    gen [] Integer
    r (Integer
    s' Integer -> Integer -> Integer
    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
         [Integer] -> Integer -> Integer -> Integer -> Integer -> [Integer]
    forall {t}. Integral t => [t] -> t -> t -> t -> t -> [t]
    gen [] (Integer
    r Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    * Integer
    bk) Integer
    s' (Integer
    mUp Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    * Integer
    bk) (Integer
    mDn Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    * 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
    fromIntegral ([Integer] -> [Integer]
    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
    1Int -> [Int] -> [Int]
    forall a. a -> [a] -> [a]
    :[Int]
    xs)
        (Int, [Int])
    _       -> String -> (Int, [Int])
    forall a. HasCallStack => String -> a
    error String
    "roundTo: bad Value"
     where
      b2 :: Int
    b2 = Int
    base Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `quot` Int
    2

      f :: Int -> Bool -> [Int] -> (Int, [Int])
    f Int
    n Bool
    _ []     = (Int
    0, Int -> Int -> [Int]
    forall a. Int -> a -> [a]
    replicate Int
    n Int
    0)
      f Int
    0 Bool
    e (Int
    x:[Int]
    xs) | Int
    x Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    b2 Bool -> Bool -> Bool
    && Bool
    e Bool -> Bool -> Bool
    && (Int -> Bool) -> [Int] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (Int -> Int -> Bool
    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 Int -> Int -> Bool
    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' Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    base = (Int
    1,Int
    0Int -> [Int] -> [Int]
    forall a. a -> [a] -> [a]
    :[Int]
    ds)
         | Bool
    otherwise  = (Int
    0,Int
    i'Int -> [Int] -> [Int]
    forall a. a -> [a] -> [a]
    :[Int]
    ds)
          where
           (Int
    c,[Int]
    ds) = Int -> Bool -> [Int] -> (Int, [Int])
    f (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1) (Int -> Bool
    forall a. Integral a => a -> Bool
    even Int
    i) [Int]
    xs
           i' :: Int
    i'     = Int
    c Int -> Int -> Int
    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 Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    == Integer
    2 Bool -> Bool -> Bool
    && Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    minExpt Bool -> Bool -> Bool
    && Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    maxExpt = Array Int Integer
    expts Array Int Integer -> Int -> Integer
    forall i. Ix i => Array i Integer -> Int -> Integer
    forall (a :: * -> * -> *) e i.
    (IArray a e, Ix i) =>
    a i e -> Int -> e
    `unsafeAt` Int
    n
        | Integer
    base Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    == Integer
    10 Bool -> Bool -> Bool
    && Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    maxExpt10              = Array Int Integer
    expts10 Array Int Integer -> Int -> Integer
    forall i. Ix i => Array i Integer -> Int -> Integer
    forall (a :: * -> * -> *) e i.
    (IArray a e, Ix i) =>
    a i e -> Int -> e
    `unsafeAt` Int
    n
        | Bool
    otherwise                                 = Integer
    baseInteger -> Int -> Integer
    forall a b. (Num a, Integral b) => a -> b -> a
    ^Int
    n

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