    {-# LANGUAGE BangPatterns, CPP, MagicHash, OverloadedStrings, UnboxedTuples #-}

    -- Module:      Blaze.Text.Double.Native
    -- Copyright:   (c) 2011 MailRank, Inc.
    -- License:     BSD3
    -- Maintainer:  Bryan O'Sullivan <bos@serpentine.com>
    -- Stability:   experimental
    -- Portability: portable
    --
    -- Efficiently serialize a Double as a lazy 'L.ByteString'.

    module Blaze.Text.Double.Native
        (
          float
        , double
        ) where

    import Blaze.ByteString.Builder (Builder, fromByteString)
    import Blaze.ByteString.Builder.Char8 (fromChar)
    import Blaze.Text.Int (digit, integral, minus)
    import Data.ByteString.Char8 ()
    import Data.Monoid (mappend, mconcat, mempty)
    import qualified Data.Vector as V

    -- The code below is originally from GHC.Float, but has been optimised
    -- in quite a few ways.

    data T = T [Int] {-# UNPACK #-} !Int

    float :: Float -> Builder
    float :: Float -> Builder
    float = Double -> Builder
    double (Double -> Builder) -> (Float -> Double) -> Float -> Builder
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Float -> Double
    forall a b. (Real a, Fractional b) => a -> b
    realToFrac

    double :: Double -> Builder
    double :: Double -> Builder
    double Double
    f
        | Double -> Bool
    forall a. RealFloat a => a -> Bool
    isInfinite Double
    f              = ByteString -> Builder
    fromByteString (ByteString -> Builder) -> ByteString -> Builder
    forall a b. (a -> b) -> a -> b
    $
                                      if Double
    f Double -> Double -> Bool
    forall a. Ord a => a -> a -> Bool
    > Double
    0 then ByteString
    "Infinity" else ByteString
    "-Infinity"
        | Double
    f Double -> Double -> Bool
    forall a. Ord a => a -> a -> Bool
    < Double
    0 Bool -> Bool -> Bool
    || Double -> Bool
    forall a. RealFloat a => a -> Bool
    isNegativeZero Double
    f = Builder
    minus Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` T -> Builder
    goGeneric (Double -> T
    floatToDigits (-Double
    f))
        | Double
    f Double -> Double -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Double
    0                    = T -> Builder
    goGeneric (Double -> T
    floatToDigits Double
    f)
        | Bool
    otherwise                 = ByteString -> Builder
    fromByteString ByteString
    "NaN"
      where
       goGeneric :: T -> Builder
    goGeneric p :: T
    p@(T [Int]
    _ Int
    e)
         | 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 = T -> Builder
    goExponent T
    p
         | Bool
    otherwise      = T -> Builder
    goFixed    T
    p
       goExponent :: T -> Builder
    goExponent (T [Int]
    is Int
    e) =
           case [Int]
    is of
             []     -> String -> Builder
    forall a. HasCallStack => String -> a
    error String
    "putFormattedFloat"
             [Int
    0]    -> ByteString -> Builder
    fromByteString ByteString
    "0.0e0"
             [Int
    d]    -> Int -> Builder
    forall a. Integral a => a -> Builder
    digit Int
    d Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` ByteString -> Builder
    fromByteString ByteString
    ".0e" Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` Int -> Builder
    forall a. (Integral a, Show a) => a -> Builder
    integral (Int
    eInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1)
             (Int
    d:[Int]
    ds) -> Int -> Builder
    forall a. Integral a => a -> Builder
    digit Int
    d Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` Char -> Builder
    fromChar Char
    '.' Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` [Int] -> Builder
    digits [Int]
    ds Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend`
                       Char -> Builder
    fromChar Char
    'e' Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` Int -> Builder
    forall a. (Integral a, Show a) => a -> Builder
    integral (Int
    eInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1)
       goFixed :: T -> Builder
    goFixed (T [Int]
    is Int
    e)
           | Int
    e Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    0    = Char -> Builder
    fromChar Char
    '0' Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` Char -> Builder
    fromChar Char
    '.' Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend`
                         [Builder] -> Builder
    forall a. Monoid a => [a] -> a
    mconcat (Int -> Builder -> [Builder]
    forall a. Int -> a -> [a]
    replicate (-Int
    e) (Char -> Builder
    fromChar Char
    '0')) Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend`
                         [Int] -> Builder
    digits [Int]
    is
           | Bool
    otherwise = let g :: t -> [Int] -> Builder
    g t
    0 [Int]
    rs     = Char -> Builder
    fromChar Char
    '.' Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` [Int] -> Builder
    mk0 [Int]
    rs
                             g t
    n []     = Char -> Builder
    fromChar Char
    '0' Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` t -> [Int] -> Builder
    g (t
    nt -> t -> t
    forall a. Num a => a -> a -> a
    -t
    1) []
                             g t
    n (Int
    r:[Int]
    rs) = Int -> Builder
    forall a. Integral a => a -> Builder
    digit Int
    r Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` t -> [Int] -> Builder
    g (t
    nt -> t -> t
    forall a. Num a => a -> a -> a
    -t
    1) [Int]
    rs
                         in Int -> [Int] -> Builder
    forall {t}. (Eq t, Num t) => t -> [Int] -> Builder
    g Int
    e [Int]
    is
       mk0 :: [Int] -> Builder
    mk0 [] = Char -> Builder
    fromChar Char
    '0'
       mk0 [Int]
    rs = [Int] -> Builder
    digits [Int]
    rs

    digits :: [Int] -> Builder
    digits :: [Int] -> Builder
    digits (Int
    d:[Int]
    ds) = Int -> Builder
    forall a. Integral a => a -> Builder
    digit Int
    d Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` [Int] -> Builder
    digits [Int]
    ds
    digits [Int]
    _      = Builder
    forall a. Monoid a => a
    mempty
    {-# INLINE digits #-}

    floatToDigits :: Double -> T
    floatToDigits :: Double -> T
    floatToDigits Double
    0 = [Int] -> Int -> T
    T [Int
    0] Int
    0
    floatToDigits Double
    x = [Int] -> Int -> T
    T ([Int] -> [Int]
    forall a. [a] -> [a]
    reverse [Int]
    rds) Int
    k
     where
      (Integer
    f0, Int
    e0)     = Double -> (Integer, Int)
    forall a. RealFloat a => a -> (Integer, Int)
    decodeFloat Double
    x
      (Int
    minExp0, Int
    _) = Double -> (Int, Int)
    forall a. RealFloat a => a -> (Int, Int)
    floatRange (Double
    forall a. HasCallStack => a
    undefined::Double)
      p :: Int
    p = Double -> Int
    forall a. RealFloat a => a -> Int
    floatDigits Double
    x
      b :: Integer
    b = Double -> Integer
    forall a. RealFloat a => a -> Integer
    floatRadix Double
    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
    `div` (Integer
    bInteger -> Int -> Integer
    forall a b. (Num a, Integral b) => a -> b -> a
    ^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
    bInteger -> Int -> Integer
    forall a b. (Num a, Integral b) => a -> b -> a
    ^ Int
    e
            in if Integer
    f Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    == Integer
    bInteger -> Int -> Integer
    forall a b. (Num a, Integral b) => a -> b -> a
    ^(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
    b #)
               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
    bInteger -> Int -> Integer
    forall a b. (Num a, Integral b) => a -> b -> a
    ^(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
    bInteger -> Int -> Integer
    forall a b. (Num a, Integral b) => a -> b -> a
    ^(-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
    bInteger -> Int -> Integer
    forall a b. (Num a, Integral b) => a -> b -> a
    ^(-Int
    e)Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    *Integer
    2, Integer
    1, Integer
    1 #)
      k :: Int
    k = Int -> Int
    fixup Int
    k0
       where
        k0 :: Int
    k0 | Integer
    b Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    == Integer
    2 = (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) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    3 Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    10
            -- logBase 10 2 is slightly bigger than 3/10 so the following
            -- will err on the low side.  Ignoring the fraction will make
            -- it err even more.  Haskell promises that p-1 <= logBase b f
            -- < p.
           | Bool
    otherwise = Double -> Int
    forall b. Integral b => Double -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    ceiling ((Double -> Double
    forall a. Floating a => a -> a
    log (Integer -> Double
    forall a. Num a => Integer -> a
    fromInteger (Integer
    fInteger -> Integer -> Integer
    forall a. Num a => a -> a -> a
    +Integer
    1) :: Double) Double -> Double -> Double
    forall a. Num a => a -> a -> a
    +
                                   Int -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    e Double -> Double -> Double
    forall a. Num a => a -> a -> a
    * Double -> Double
    forall a. Floating a => a -> a
    log (Integer -> Double
    forall a. Num a => Integer -> a
    fromInteger Integer
    b)) Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / Double -> Double
    forall a. Floating a => a -> a
    log Double
    10)
        fixup :: Int -> Int
    fixup Int
    n
          | Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    0    = 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
    <= Int -> Integer
    exp10 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)
          | Bool
    otherwise = if Int -> Integer
    exp10 (-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)

      gen :: [a] -> Integer -> Integer -> Integer -> Integer -> [a]
    gen [a]
    ds !Integer
    rn !Integer
    sN !Integer
    mUpN !Integer
    mDnN =
       let (Integer
    dn0, Integer
    rn') = (Integer
    rn Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    * Integer
    10) Integer -> Integer -> (Integer, Integer)
    forall a. Integral a => a -> a -> (a, a)
    `divMod` Integer
    sN
           mUpN' :: Integer
    mUpN' = Integer
    mUpN Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    * Integer
    10
           mDnN' :: Integer
    mDnN' = Integer
    mDnN Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    * Integer
    10
           !dn :: a
    dn   = Integer -> a
    forall a. Num a => Integer -> a
    fromInteger Integer
    dn0
           !dn' :: a
    dn'  = a
    dn a -> a -> a
    forall a. Num a => a -> a -> a
    + a
    1
       in case (# Integer
    rn' Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    < Integer
    mDnN', Integer
    rn' Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    + Integer
    mUpN' Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    > Integer
    sN #) of
            (# Bool
    True,  Bool
    False #) -> a
    dn a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : [a]
    ds
            (# Bool
    False, Bool
    True #)  -> a
    dn' a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : [a]
    ds
            (# Bool
    True,  Bool
    True #)  -> if Integer
    rn' Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    * Integer
    2 Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    < Integer
    sN then a
    dn a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : [a]
    ds else a
    dn' a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : [a]
    ds
            (# Bool
    False, Bool
    False #) -> [a] -> Integer -> Integer -> Integer -> Integer -> [a]
    gen (a
    dna -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    ds) Integer
    rn' Integer
    sN Integer
    mUpN' Integer
    mDnN'

      rds :: [Int]
    rds | Int
    k Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    0    = [Int] -> Integer -> Integer -> Integer -> Integer -> [Int]
    forall {a}.
    Num a =>
    [a] -> Integer -> Integer -> Integer -> Integer -> [a]
    gen [] Integer
    r (Integer
    s Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    * Int -> Integer
    exp10 Int
    k) Integer
    mUp Integer
    mDn
          | Bool
    otherwise = [Int] -> Integer -> Integer -> Integer -> Integer -> [Int]
    forall {a}.
    Num a =>
    [a] -> Integer -> Integer -> Integer -> Integer -> [a]
    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)
          where bk :: Integer
    bk = Int -> Integer
    exp10 (-Int
    k)

    exp10 :: Int -> Integer
    exp10 :: Int -> Integer
    exp10 Int
    n
        | Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    0 Bool -> Bool -> Bool
    && Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    maxExpt = Vector Integer -> Int -> Integer
    forall a. Vector a -> Int -> a
    V.unsafeIndex Vector Integer
    expts Int
    n
        | Bool
    otherwise             = Integer
    10 Integer -> Int -> Integer
    forall a b. (Num a, Integral b) => a -> b -> a
    ^ Int
    n
      where expts :: Vector Integer
    expts = Int -> (Int -> Integer) -> Vector Integer
    forall a. Int -> (Int -> a) -> Vector a
    V.generate Int
    maxExpt (Integer
    10Integer -> Int -> Integer
    forall a b. (Num a, Integral b) => a -> b -> a
    ^)
            {-# NOINLINE expts #-}
            maxExpt :: Int
    maxExpt = Int
    17
    {-# INLINE exp10 #-}