content: module Numeric(
    showSigned,
    showIntAtBase,
    showInt,
    showBin,
    showHex,
    showOct,
    showEFloat,--
    showFFloat,
    showGFloat,
    showFloat,
    floatToDigits,
    readSigned,
    readInt,
    readBin,
    readDec,
    readOct,
    readHex,
    readFloat,
    lexDigits,
    fromRat,
    ) where
  import qualified Prelude(); import MiniPrelude
  import Data.Fractional
  import Data.Integer_Type
  import Data.Ratio
  import Data.Ratio_Type
  import Data.Real
  import Data.RealFloat
  import Data.RealFrac
  import Numeric.FormatFloat
  import Numeric.Read
  import Numeric.Show
  import Text.ParserCombinators.ReadP (ReadP, pfail, readP_to_S)
  import Text.Read.Internal (ReadS, lexDigits)
  import qualified Text.Read.Lex as L
  
  -- | Reads an /unsigned/ 'RealFrac' value,
  -- expressed in decimal scientific notation.
  readFloat :: RealFrac a => ReadS a
  readFloat = readP_to_S readFloatP
  
  readFloatP :: RealFrac a => ReadP a
  readFloatP =
    do tok <- L.lex
       case tok of
         L.Number n -> return $ fromRational $ L.numberToRational n
         _          -> pfail
  
  -- | Converts a 'Rational' value into any type in class 'RealFloat'.
  fromRat :: (RealFloat a) => Rational -> a
  
  -- Deal with special cases first, delegating the real work to fromRat'
  fromRat (n :% 0) | n > 0     =   1/0       -- +Infinity
                   | n < 0     = -(1/0)      -- -Infinity
                   | otherwise =   0/0       -- NaN
  
  fromRat (n :% d) | n > 0     = fromRat' (n :% d)
                   | n < 0     = - fromRat' ((-n) :% d)
                   | otherwise = encodeFloat 0 0             -- Zero
  
  fromRat' :: (RealFloat a) => Rational -> a
  -- Invariant: argument is strictly positive
  fromRat' x = r
    where
      n = numerator x
      d = denominator x
      b = floatRadix r
      p = floatDigits r
      (minExp, _) = floatRange r
      maxVal = b ^ p
      r =
        if n < maxVal && d < maxVal then
          -- no scaling needed
          fromInteger n / fromInteger d
        else
          let
            ln = integerLogBase b n
            ld = integerLogBase b d
            -- b^(ln-ld-1) < x < b^(ln-ld+1)
            p0 = max (ln - ld) minExp - p
            f = if p0 < 0 then 1 :% (b ^ (-p0)) else (b ^ p0) :% 1
            x0 = x / f
            -- if ln - ld >= minExp, then b^(p-1) < x0 < b^(p+1), so there's at most
            -- one scaling step needed, otherwise, x0 < b^p and no scaling is needed
            (x', p') = if x0 >= toRational maxVal then (x0 / toRational b, p0 + 1) else (x0, p0)
          in encodeFloat (round x') p'
  
  -- @integerLogBase b i@ is the logarithm of @i@ to base @b@, rounded down.
  integerLogBase :: Integer -> Integer -> Int
  integerLogBase b i
    | i == 0 = 0 :: Int
    | b < 2 = error "invalid base"
    | otherwise = case go b of (_, e) -> e
    where
      go p = if i < p
        then (i, 0)
        else case go (p * p) of
          (q, e) -> if q < p
            then (q, 2 * e)
            else (q `quot` p, 2 * e + 1)
  