{-|
Module      : Z.Data.Builder.Numeric
Description : Textual numeric builders.
Copyright   : (c) Dong Han, 2017-2019
License     : BSD
Maintainer  : winterland1989@gmail.com
Stability   : experimental
Portability : non-portable

Textual numeric builders.

-}

module Z.Data.Builder.Numeric (
  -- * Integral type formatting

    IFormat(..)
  , defaultIFormat
  , Padding(..)
  , int
  , intWith
  , integer
  -- * Fixded size hexidecimal formatting
  , hex, hexUpper
  -- * IEEE float formating
  , FFormat(..)
  , double
  , doubleWith
  , float
  , floatWith
  , scientific
  , scientific'
  , scientificWith
  -- * Misc
  , grisu3
  , grisu3_sp
  , i2wDec, i2wHex, i2wHexUpper
  , countDigits
  , c_intWith, hs_intWith
  , quotRem10
) where

import           Control.Monad
import           Data.Bits
import           Data.Int
import qualified Data.List                           as List
import           Data.Primitive.ByteArray
import           Data.Primitive.PrimArray
import qualified Data.Scientific                     as Sci
import           Data.Word
import           GHC.Exts
import           GHC.Float
import           GHC.Num
import           Z.Data.ASCII
import           Z.Data.Builder.Base
import           Z.Data.Builder.Numeric.DigitTable
import           Z.Foreign
import           System.IO.Unsafe
import           Test.QuickCheck.Arbitrary           (Arbitrary(..), CoArbitrary(..))

--------------------------------------------------------------------------------

foreign import ccall unsafe "dtoa.h"
    c_int_dec :: Word64 -> Int -> Int -> Word8 -> MBA# Word8 -> Int -> IO Int

-- | Integral formatting options.
--
data IFormat = IFormat
    { IFormat -> Int
width       :: Int            -- ^ total width, only effective with padding options
    , IFormat -> Padding
padding     :: Padding        -- ^ padding options
    , IFormat -> Bool
posSign     :: Bool           -- ^ show @+@ when the number is positive
    } deriving (Int -> IFormat -> ShowS
[IFormat] -> ShowS
IFormat -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IFormat] -> ShowS
$cshowList :: [IFormat] -> ShowS
show :: IFormat -> String
$cshow :: IFormat -> String
showsPrec :: Int -> IFormat -> ShowS
$cshowsPrec :: Int -> IFormat -> ShowS
Show, IFormat -> IFormat -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IFormat -> IFormat -> Bool
$c/= :: IFormat -> IFormat -> Bool
== :: IFormat -> IFormat -> Bool
$c== :: IFormat -> IFormat -> Bool
Eq, Eq IFormat
IFormat -> IFormat -> Bool
IFormat -> IFormat -> Ordering
IFormat -> IFormat -> IFormat
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: IFormat -> IFormat -> IFormat
$cmin :: IFormat -> IFormat -> IFormat
max :: IFormat -> IFormat -> IFormat
$cmax :: IFormat -> IFormat -> IFormat
>= :: IFormat -> IFormat -> Bool
$c>= :: IFormat -> IFormat -> Bool
> :: IFormat -> IFormat -> Bool
$c> :: IFormat -> IFormat -> Bool
<= :: IFormat -> IFormat -> Bool
$c<= :: IFormat -> IFormat -> Bool
< :: IFormat -> IFormat -> Bool
$c< :: IFormat -> IFormat -> Bool
compare :: IFormat -> IFormat -> Ordering
$ccompare :: IFormat -> IFormat -> Ordering
Ord)

instance Arbitrary IFormat where
    arbitrary :: Gen IFormat
arbitrary = Int -> Padding -> Bool -> IFormat
IFormat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary

instance CoArbitrary IFormat where
    coarbitrary :: forall b. IFormat -> Gen b -> Gen b
coarbitrary (IFormat Int
w Padding
pad Bool
p) = forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary (Int
w, Padding
pad, Bool
p)


-- | @defaultIFormat = IFormat 0 NoPadding False@
defaultIFormat :: IFormat
{-# INLINE defaultIFormat #-}
defaultIFormat :: IFormat
defaultIFormat = Int -> Padding -> Bool -> IFormat
IFormat Int
0 Padding
NoPadding Bool
False

-- | Padding format.
data Padding = NoPadding | RightSpacePadding | LeftSpacePadding | ZeroPadding deriving (Int -> Padding -> ShowS
[Padding] -> ShowS
Padding -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Padding] -> ShowS
$cshowList :: [Padding] -> ShowS
show :: Padding -> String
$cshow :: Padding -> String
showsPrec :: Int -> Padding -> ShowS
$cshowsPrec :: Int -> Padding -> ShowS
Show, Padding -> Padding -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Padding -> Padding -> Bool
$c/= :: Padding -> Padding -> Bool
== :: Padding -> Padding -> Bool
$c== :: Padding -> Padding -> Bool
Eq, Eq Padding
Padding -> Padding -> Bool
Padding -> Padding -> Ordering
Padding -> Padding -> Padding
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Padding -> Padding -> Padding
$cmin :: Padding -> Padding -> Padding
max :: Padding -> Padding -> Padding
$cmax :: Padding -> Padding -> Padding
>= :: Padding -> Padding -> Bool
$c>= :: Padding -> Padding -> Bool
> :: Padding -> Padding -> Bool
$c> :: Padding -> Padding -> Bool
<= :: Padding -> Padding -> Bool
$c<= :: Padding -> Padding -> Bool
< :: Padding -> Padding -> Bool
$c< :: Padding -> Padding -> Bool
compare :: Padding -> Padding -> Ordering
$ccompare :: Padding -> Padding -> Ordering
Ord, Int -> Padding
Padding -> Int
Padding -> [Padding]
Padding -> Padding
Padding -> Padding -> [Padding]
Padding -> Padding -> Padding -> [Padding]
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 :: Padding -> Padding -> Padding -> [Padding]
$cenumFromThenTo :: Padding -> Padding -> Padding -> [Padding]
enumFromTo :: Padding -> Padding -> [Padding]
$cenumFromTo :: Padding -> Padding -> [Padding]
enumFromThen :: Padding -> Padding -> [Padding]
$cenumFromThen :: Padding -> Padding -> [Padding]
enumFrom :: Padding -> [Padding]
$cenumFrom :: Padding -> [Padding]
fromEnum :: Padding -> Int
$cfromEnum :: Padding -> Int
toEnum :: Int -> Padding
$ctoEnum :: Int -> Padding
pred :: Padding -> Padding
$cpred :: Padding -> Padding
succ :: Padding -> Padding
$csucc :: Padding -> Padding
Enum)

instance Arbitrary Padding where
    arbitrary :: Gen Padding
arbitrary = forall a. Enum a => Int -> a
toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Integral a => a -> a -> a
`mod` Int
4) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary

instance CoArbitrary Padding where
    coarbitrary :: forall b. Padding -> Gen b -> Gen b
coarbitrary = forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum

-- | @int = intWith defaultIFormat@
int :: (Integral a, Bounded a) => a -> Builder ()
{-# INLINE int #-}
int :: forall a. (Integral a, Bounded a) => a -> Builder ()
int = forall a. (Integral a, Bounded a) => IFormat -> a -> Builder ()
intWith IFormat
defaultIFormat

-- | Format a 'Bounded' 'Integral' type like @Int@ or @Word16@ into decimal ASCII digits.
--
-- @
-- import Z.Data.Builder as B
--
-- > B.buildText $ B.intWith defaultIFormat  (12345 :: Int)
-- "12345"
-- > B.buildText $ B.intWith defaultIFormat{width=10, padding=RightSpacePadding} (12345 :: Int)
-- "12345     "
-- > B.buildText $ B.intWith defaultIFormat{width=10, padding=ZeroPadding} (12345 :: Int)
-- "0000012345"
-- @
--
intWith :: (Integral a, Bounded a) => IFormat -> a -> Builder ()
intWith :: forall a. (Integral a, Bounded a) => IFormat -> a -> Builder ()
intWith = forall a. (Integral a, Bounded a) => IFormat -> a -> Builder ()
hs_intWith
{-# INLINE [1] intWith #-}
{-# RULES "intWith'/Int"     intWith = c_intWith  :: IFormat -> Int     -> Builder () #-}
{-# RULES "intWith'/Int8"    intWith = c_intWith  :: IFormat -> Int8    -> Builder () #-}
{-# RULES "intWith'/Int16"   intWith = c_intWith  :: IFormat -> Int16   -> Builder () #-}
{-# RULES "intWith'/Int32"   intWith = c_intWith  :: IFormat -> Int32   -> Builder () #-}
{-# RULES "intWith'/Int64"   intWith = c_intWith  :: IFormat -> Int64   -> Builder () #-}
{-# RULES "intWith'/Word"    intWith = c_intWith  :: IFormat -> Word    -> Builder () #-}
{-# RULES "intWith'/Word8"   intWith = c_intWith  :: IFormat -> Word8   -> Builder () #-}
{-# RULES "intWith'/Word16"  intWith = c_intWith  :: IFormat -> Word16  -> Builder () #-}
{-# RULES "intWith'/Word32"  intWith = c_intWith  :: IFormat -> Word32  -> Builder () #-}
{-# RULES "intWith'/Word64"  intWith = c_intWith  :: IFormat -> Word64  -> Builder () #-}
{-# RULES "intWith'/CShort"  intWith = c_intWith  :: IFormat -> CShort  -> Builder () #-}
{-# RULES "intWith'/CUShort" intWith = c_intWith  :: IFormat -> CUShort -> Builder () #-}
{-# RULES "intWith'/CInt"    intWith = c_intWith  :: IFormat -> CInt    -> Builder () #-}
{-# RULES "intWith'/CUInt"   intWith = c_intWith  :: IFormat -> CUInt   -> Builder () #-}
{-# RULES "intWith'/CLong"   intWith = c_intWith  :: IFormat -> CLong   -> Builder () #-}
{-# RULES "intWith'/CULong"  intWith = c_intWith  :: IFormat -> CULong  -> Builder () #-}
{-# RULES "intWith'/CLLong"  intWith = c_intWith  :: IFormat -> CLLong  -> Builder () #-}
{-# RULES "intWith'/CULLong" intWith = c_intWith  :: IFormat -> CULLong -> Builder () #-}

-- | Internal formatting backed by C FFI, it must be used with type smaller than 'Word64'.
--
-- We use rewrite rules to rewrite most of the integral types formatting to this function.
c_intWith :: (Integral a, Bits a) => IFormat -> a -> Builder ()
{-# INLINE c_intWith #-}
c_intWith :: forall a. (Integral a, Bits a) => IFormat -> a -> Builder ()
c_intWith (IFormat{Bool
Int
Padding
posSign :: Bool
padding :: Padding
width :: Int
posSign :: IFormat -> Bool
padding :: IFormat -> Padding
width :: IFormat -> Int
..}) = \ a
x ->
    Int
-> (MutablePrimArray RealWorld Word8 -> Int -> IO Int)
-> Builder ()
ensureN (forall a. Ord a => a -> a -> a
max Int
21 Int
width) (\ (MutablePrimArray MutableByteArray# RealWorld
mba#) Int
i ->
        if a
x forall a. Ord a => a -> a -> Bool
< a
0
        then let !x' :: Word64
x' = (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> a
complement a
x) :: Word64) forall a. Num a => a -> a -> a
+ Word64
1
             in (Word64
-> Int
-> Int
-> Word8
-> MutableByteArray# RealWorld
-> Int
-> IO Int
c_int_dec Word64
x' (-Int
1) Int
width Word8
pad MutableByteArray# RealWorld
mba# Int
i)
        else Word64
-> Int
-> Int
-> Word8
-> MutableByteArray# RealWorld
-> Int
-> IO Int
c_int_dec (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x) (if Bool
posSign then Int
1 else Int
0) Int
width Word8
pad MutableByteArray# RealWorld
mba# Int
i)
  where
    pad :: Word8
pad = case Padding
padding of Padding
NoPadding          -> Word8
0
                          Padding
RightSpacePadding  -> Word8
1
                          Padding
LeftSpacePadding   -> Word8
2
                          Padding
_                  -> Word8
3

-- | Internal formatting in haskell, it can be used with any bounded integral type.
--
-- Other than provide fallback for the c version, this function is also used to check
-- the c version's formatting result.
hs_intWith :: (Integral a, Bounded a) => IFormat -> a -> Builder ()
{-# INLINABLE hs_intWith #-}
hs_intWith :: forall a. (Integral a, Bounded a) => IFormat -> a -> Builder ()
hs_intWith format :: IFormat
format@IFormat{Bool
Int
Padding
posSign :: Bool
padding :: Padding
width :: Int
posSign :: IFormat -> Bool
padding :: IFormat -> Padding
width :: IFormat -> Int
..} a
i
    | a
i forall a. Ord a => a -> a -> Bool
< a
0 =
        if a
i forall a. Eq a => a -> a -> Bool
== forall a. Bounded a => a
minBound            -- can't directly negate in this case
        then do
            let (a
q, a
r) = a
i forall a. Integral a => a -> a -> (a, a)
`quotRem` a
10
                !qq :: a
qq = -a
q            -- all digits except last one
                !rr :: Word8
rr = forall a. Integral a => a -> Word8
i2wDec (-a
r)      -- last digits
                !n :: Int
n = forall a. Integral a => a -> Int
countDigits a
qq
                !n' :: Int
n' = Int
n forall a. Num a => a -> a -> a
+ Int
2         -- extra two bytes: MINUS and last digit
            if Int
width forall a. Ord a => a -> a -> Bool
> Int
n'
            then case Padding
padding of
                Padding
NoPadding ->
                    Int
-> (MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ()
writeN Int
n' forall a b. (a -> b) -> a -> b
$ \MutablePrimArray RealWorld Word8
marr Int
off -> do
                        forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld Word8
marr Int
off Word8
MINUS                       -- leading MINUS
                        let off' :: Int
off' = Int
off forall a. Num a => a -> a -> a
+ Int
1
                        forall a.
Integral a =>
MutablePrimArray RealWorld Word8 -> Int -> Int -> a -> IO ()
writePositiveDec MutablePrimArray RealWorld Word8
marr Int
off' Int
n a
qq                      -- digits
                        let off'' :: Int
off'' = Int
off' forall a. Num a => a -> a -> a
+ Int
n
                        forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld Word8
marr Int
off'' Word8
rr                        -- last digit
                Padding
ZeroPadding ->
                    Int
-> (MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ()
writeN Int
width forall a b. (a -> b) -> a -> b
$ \MutablePrimArray RealWorld Word8
marr Int
off -> do
                        let !leadingN :: Int
leadingN = Int
widthforall a. Num a => a -> a -> a
-Int
n'
                        forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld Word8
marr Int
off Word8
MINUS                   -- leading MINUS
                        let off' :: Int
off' = Int
off forall a. Num a => a -> a -> a
+ Int
1
                        forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> Int -> a -> m ()
setPrimArray MutablePrimArray RealWorld Word8
marr Int
off' Int
leadingN Word8
DIGIT_0            -- leading zeros
                        let off'' :: Int
off'' = Int
off' forall a. Num a => a -> a -> a
+ Int
leadingN
                        forall a.
Integral a =>
MutablePrimArray RealWorld Word8 -> Int -> Int -> a -> IO ()
writePositiveDec MutablePrimArray RealWorld Word8
marr Int
off'' Int
n a
qq                 -- digits
                        let off''' :: Int
off''' = Int
off'' forall a. Num a => a -> a -> a
+ Int
n
                        forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld Word8
marr Int
off''' Word8
rr                   -- last digit
                Padding
LeftSpacePadding ->
                    Int
-> (MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ()
writeN Int
width forall a b. (a -> b) -> a -> b
$ \MutablePrimArray RealWorld Word8
marr Int
off -> do
                        let !leadingN :: Int
leadingN = Int
widthforall a. Num a => a -> a -> a
-Int
n'
                        forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> Int -> a -> m ()
setPrimArray MutablePrimArray RealWorld Word8
marr Int
off Int
leadingN Word8
SPACE            -- leading spaces
                        let off' :: Int
off' = Int
off forall a. Num a => a -> a -> a
+ Int
leadingN
                        forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld Word8
marr Int
off' Word8
MINUS                  -- leading MINUS
                        let off'' :: Int
off'' = Int
off' forall a. Num a => a -> a -> a
+ Int
1
                        forall a.
Integral a =>
MutablePrimArray RealWorld Word8 -> Int -> Int -> a -> IO ()
writePositiveDec MutablePrimArray RealWorld Word8
marr Int
off'' Int
n a
qq                 -- digits
                        let off''' :: Int
off''' = Int
off'' forall a. Num a => a -> a -> a
+ Int
n
                        forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld Word8
marr Int
off''' Word8
rr                   -- last digit
                Padding
RightSpacePadding ->
                    Int
-> (MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ()
writeN Int
width forall a b. (a -> b) -> a -> b
$ \MutablePrimArray RealWorld Word8
marr Int
off -> do
                        let !trailingN :: Int
trailingN = Int
widthforall a. Num a => a -> a -> a
-Int
n'
                        forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld Word8
marr Int
off Word8
MINUS                   -- leading MINUS
                        let off' :: Int
off' = Int
off forall a. Num a => a -> a -> a
+ Int
1
                        forall a.
Integral a =>
MutablePrimArray RealWorld Word8 -> Int -> Int -> a -> IO ()
writePositiveDec MutablePrimArray RealWorld Word8
marr Int
off' Int
n a
qq                  -- digits
                        let off'' :: Int
off'' = Int
off' forall a. Num a => a -> a -> a
+ Int
n
                        forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld Word8
marr Int
off'' Word8
rr                    -- last digit
                        let off''' :: Int
off''' = Int
off'' forall a. Num a => a -> a -> a
+ Int
1
                        forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> Int -> a -> m ()
setPrimArray MutablePrimArray RealWorld Word8
marr Int
off''' Int
trailingN Word8
SPACE        -- trailing spaces
            else
                Int
-> (MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ()
writeN Int
n' forall a b. (a -> b) -> a -> b
$ \MutablePrimArray RealWorld Word8
marr Int
off -> do
                    forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld Word8
marr Int
off Word8
MINUS                       -- leading MINUS
                    let off' :: Int
off' = Int
off forall a. Num a => a -> a -> a
+ Int
1
                    forall a.
Integral a =>
MutablePrimArray RealWorld Word8 -> Int -> Int -> a -> IO ()
writePositiveDec MutablePrimArray RealWorld Word8
marr Int
off' Int
n a
qq                      -- digits
                    let off'' :: Int
off'' = Int
off' forall a. Num a => a -> a -> a
+ Int
n
                    forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld Word8
marr Int
off'' Word8
rr                        -- last digit
        else do
            let !qq :: a
qq = -a
i
                !n :: Int
n = forall a. Integral a => a -> Int
countDigits a
qq
                !n' :: Int
n' = Int
n forall a. Num a => a -> a -> a
+ Int
1  -- extra byte: MINUS
            if Int
width forall a. Ord a => a -> a -> Bool
> Int
n'
            then case Padding
padding of
                Padding
NoPadding ->
                    Int
-> (MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ()
writeN Int
n' forall a b. (a -> b) -> a -> b
$ \MutablePrimArray RealWorld Word8
marr Int
off -> do
                        forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld Word8
marr Int
off Word8
MINUS                       -- leading MINUS
                        let off' :: Int
off' = Int
off forall a. Num a => a -> a -> a
+ Int
1
                        forall a.
Integral a =>
MutablePrimArray RealWorld Word8 -> Int -> Int -> a -> IO ()
writePositiveDec MutablePrimArray RealWorld Word8
marr Int
off' Int
n a
qq                      -- digits
                Padding
ZeroPadding ->
                    Int
-> (MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ()
writeN Int
width forall a b. (a -> b) -> a -> b
$ \MutablePrimArray RealWorld Word8
marr Int
off -> do
                        let !leadingN :: Int
leadingN = Int
widthforall a. Num a => a -> a -> a
-Int
n'
                        forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld Word8
marr Int
off Word8
MINUS                   -- leading MINUS
                        let off' :: Int
off' = Int
off forall a. Num a => a -> a -> a
+ Int
1
                        forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> Int -> a -> m ()
setPrimArray MutablePrimArray RealWorld Word8
marr Int
off' Int
leadingN Word8
DIGIT_0            -- leading zeros
                        let off'' :: Int
off'' = Int
off' forall a. Num a => a -> a -> a
+ Int
leadingN
                        forall a.
Integral a =>
MutablePrimArray RealWorld Word8 -> Int -> Int -> a -> IO ()
writePositiveDec MutablePrimArray RealWorld Word8
marr Int
off'' Int
n a
qq                 -- digits
                Padding
LeftSpacePadding ->
                    Int
-> (MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ()
writeN Int
width forall a b. (a -> b) -> a -> b
$ \MutablePrimArray RealWorld Word8
marr Int
off -> do
                        let !leadingN :: Int
leadingN = Int
widthforall a. Num a => a -> a -> a
-Int
n'
                        forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> Int -> a -> m ()
setPrimArray MutablePrimArray RealWorld Word8
marr Int
off Int
leadingN Word8
SPACE            -- leading spaces
                        let off' :: Int
off' = Int
off forall a. Num a => a -> a -> a
+ Int
leadingN
                        forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld Word8
marr Int
off' Word8
MINUS                  -- leading MINUS
                        let off'' :: Int
off'' = Int
off' forall a. Num a => a -> a -> a
+ Int
1
                        forall a.
Integral a =>
MutablePrimArray RealWorld Word8 -> Int -> Int -> a -> IO ()
writePositiveDec MutablePrimArray RealWorld Word8
marr Int
off'' Int
n a
qq                 -- digits
                Padding
RightSpacePadding ->
                    Int
-> (MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ()
writeN Int
width forall a b. (a -> b) -> a -> b
$ \MutablePrimArray RealWorld Word8
marr Int
off -> do
                        let !trailingN :: Int
trailingN = Int
widthforall a. Num a => a -> a -> a
-Int
n'
                        forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld Word8
marr Int
off Word8
MINUS                   -- leading MINUS
                        let off' :: Int
off' = Int
off forall a. Num a => a -> a -> a
+ Int
1
                        forall a.
Integral a =>
MutablePrimArray RealWorld Word8 -> Int -> Int -> a -> IO ()
writePositiveDec MutablePrimArray RealWorld Word8
marr Int
off' Int
n a
qq                  -- digits
                        let off'' :: Int
off'' = Int
off' forall a. Num a => a -> a -> a
+ Int
n
                        forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> Int -> a -> m ()
setPrimArray MutablePrimArray RealWorld Word8
marr Int
off'' Int
trailingN Word8
SPACE         -- trailing spaces
            else
                Int
-> (MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ()
writeN Int
n' forall a b. (a -> b) -> a -> b
$ \MutablePrimArray RealWorld Word8
marr Int
off -> do
                    forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld Word8
marr Int
off Word8
MINUS                       -- leading MINUS
                    let off' :: Int
off' = Int
off forall a. Num a => a -> a -> a
+ Int
1
                    forall a.
Integral a =>
MutablePrimArray RealWorld Word8 -> Int -> Int -> a -> IO ()
writePositiveDec MutablePrimArray RealWorld Word8
marr Int
off' Int
n a
qq                      -- digits
    | Bool
otherwise = forall a. Integral a => IFormat -> a -> Builder ()
positiveInt IFormat
format a
i

positiveInt :: (Integral a) => IFormat -> a -> Builder ()
{-# INLINABLE positiveInt #-}
positiveInt :: forall a. Integral a => IFormat -> a -> Builder ()
positiveInt (IFormat Int
width Padding
padding Bool
ps) a
i =
    let !n :: Int
n = forall a. Integral a => a -> Int
countDigits a
i
    in if Bool
ps
        then
            let n' :: Int
n' = Int
nforall a. Num a => a -> a -> a
+Int
1
            in if Int
width forall a. Ord a => a -> a -> Bool
> Int
n'
            then case Padding
padding of
                Padding
NoPadding ->
                    Int
-> (MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ()
writeN Int
n' forall a b. (a -> b) -> a -> b
$ \MutablePrimArray RealWorld Word8
marr Int
off -> do
                        forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld Word8
marr Int
off Word8
PLUS                    -- leading PLUS
                        let off' :: Int
off' = Int
off forall a. Num a => a -> a -> a
+ Int
1
                        forall a.
Integral a =>
MutablePrimArray RealWorld Word8 -> Int -> Int -> a -> IO ()
writePositiveDec MutablePrimArray RealWorld Word8
marr Int
off' Int
n a
i                   -- digits
                Padding
ZeroPadding ->
                    Int
-> (MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ()
writeN Int
width forall a b. (a -> b) -> a -> b
$ \MutablePrimArray RealWorld Word8
marr Int
off -> do
                        let !leadingN :: Int
leadingN = Int
widthforall a. Num a => a -> a -> a
-Int
n'
                        forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld Word8
marr Int
off Word8
PLUS                    -- leading PLUS
                        let off' :: Int
off' = Int
off forall a. Num a => a -> a -> a
+ Int
1
                        forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> Int -> a -> m ()
setPrimArray MutablePrimArray RealWorld Word8
marr Int
off' Int
leadingN Word8
DIGIT_0            -- leading zeros
                        let off'' :: Int
off'' = Int
off' forall a. Num a => a -> a -> a
+ Int
leadingN
                        forall a.
Integral a =>
MutablePrimArray RealWorld Word8 -> Int -> Int -> a -> IO ()
writePositiveDec MutablePrimArray RealWorld Word8
marr Int
off'' Int
n a
i                  -- digits
                Padding
LeftSpacePadding ->
                    Int
-> (MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ()
writeN Int
width forall a b. (a -> b) -> a -> b
$ \MutablePrimArray RealWorld Word8
marr Int
off -> do
                        let !leadingN :: Int
leadingN = Int
widthforall a. Num a => a -> a -> a
-Int
n'
                        forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> Int -> a -> m ()
setPrimArray MutablePrimArray RealWorld Word8
marr Int
off Int
leadingN Word8
SPACE            -- leading spaces
                        let off' :: Int
off' = Int
off forall a. Num a => a -> a -> a
+ Int
leadingN
                        forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld Word8
marr Int
off' Word8
PLUS                   -- leading PLUS
                        let off'' :: Int
off'' = Int
off' forall a. Num a => a -> a -> a
+ Int
1
                        forall a.
Integral a =>
MutablePrimArray RealWorld Word8 -> Int -> Int -> a -> IO ()
writePositiveDec MutablePrimArray RealWorld Word8
marr Int
off'' Int
n a
i                  -- digits
                Padding
RightSpacePadding ->
                    Int
-> (MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ()
writeN Int
width forall a b. (a -> b) -> a -> b
$ \MutablePrimArray RealWorld Word8
marr Int
off -> do
                        let !trailingN :: Int
trailingN = Int
widthforall a. Num a => a -> a -> a
-Int
n'
                        forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld Word8
marr Int
off Word8
PLUS                    -- leading PLUS
                        let off' :: Int
off' = Int
off forall a. Num a => a -> a -> a
+ Int
1
                        forall a.
Integral a =>
MutablePrimArray RealWorld Word8 -> Int -> Int -> a -> IO ()
writePositiveDec MutablePrimArray RealWorld Word8
marr Int
off' Int
n a
i                   -- digits
                        let off'' :: Int
off'' = Int
off' forall a. Num a => a -> a -> a
+ Int
n
                        forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> Int -> a -> m ()
setPrimArray MutablePrimArray RealWorld Word8
marr Int
off'' Int
trailingN Word8
SPACE         -- trailing spaces
            else
                Int
-> (MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ()
writeN Int
n' forall a b. (a -> b) -> a -> b
$ \MutablePrimArray RealWorld Word8
marr Int
off -> do
                    forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld Word8
marr Int
off Word8
PLUS                        -- leading PLUS
                    let off' :: Int
off' = Int
off forall a. Num a => a -> a -> a
+ Int
1
                    forall a.
Integral a =>
MutablePrimArray RealWorld Word8 -> Int -> Int -> a -> IO ()
writePositiveDec MutablePrimArray RealWorld Word8
marr Int
off' Int
n a
i                       -- digits

        else if Int
width forall a. Ord a => a -> a -> Bool
> Int
n
            then case Padding
padding of
                Padding
NoPadding ->
                    Int
-> (MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ()
writeN Int
n forall a b. (a -> b) -> a -> b
$ \MutablePrimArray RealWorld Word8
marr Int
off -> do
                        forall a.
Integral a =>
MutablePrimArray RealWorld Word8 -> Int -> Int -> a -> IO ()
writePositiveDec MutablePrimArray RealWorld Word8
marr Int
off Int
n a
i                    -- digits
                Padding
ZeroPadding ->
                    Int
-> (MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ()
writeN Int
width forall a b. (a -> b) -> a -> b
$ \MutablePrimArray RealWorld Word8
marr Int
off -> do
                        let !leadingN :: Int
leadingN = Int
widthforall a. Num a => a -> a -> a
-Int
n
                        forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> Int -> a -> m ()
setPrimArray MutablePrimArray RealWorld Word8
marr Int
off Int
leadingN Word8
DIGIT_0             -- leading zeros
                        let off' :: Int
off' = Int
off forall a. Num a => a -> a -> a
+ Int
leadingN
                        forall a.
Integral a =>
MutablePrimArray RealWorld Word8 -> Int -> Int -> a -> IO ()
writePositiveDec MutablePrimArray RealWorld Word8
marr Int
off' Int
n a
i                   -- digits
                Padding
LeftSpacePadding ->
                    Int
-> (MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ()
writeN Int
width forall a b. (a -> b) -> a -> b
$ \MutablePrimArray RealWorld Word8
marr Int
off -> do
                        let !leadingN :: Int
leadingN = Int
widthforall a. Num a => a -> a -> a
-Int
n
                        forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> Int -> a -> m ()
setPrimArray MutablePrimArray RealWorld Word8
marr Int
off Int
leadingN Word8
SPACE            -- leading spaces
                        let off' :: Int
off' = Int
off forall a. Num a => a -> a -> a
+ Int
leadingN
                        forall a.
Integral a =>
MutablePrimArray RealWorld Word8 -> Int -> Int -> a -> IO ()
writePositiveDec MutablePrimArray RealWorld Word8
marr Int
off' Int
n a
i                   -- digits
                Padding
RightSpacePadding ->
                    Int
-> (MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ()
writeN Int
width forall a b. (a -> b) -> a -> b
$ \MutablePrimArray RealWorld Word8
marr Int
off -> do
                        let !trailingN :: Int
trailingN = Int
widthforall a. Num a => a -> a -> a
-Int
n
                        forall a.
Integral a =>
MutablePrimArray RealWorld Word8 -> Int -> Int -> a -> IO ()
writePositiveDec MutablePrimArray RealWorld Word8
marr Int
off Int
n a
i                    -- digits
                        let off' :: Int
off' = Int
off forall a. Num a => a -> a -> a
+ Int
n
                        forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> Int -> a -> m ()
setPrimArray MutablePrimArray RealWorld Word8
marr Int
off' Int
trailingN Word8
SPACE          -- trailing spaces
            else
                Int
-> (MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ()
writeN Int
n forall a b. (a -> b) -> a -> b
$ \MutablePrimArray RealWorld Word8
marr Int
off -> do
                    forall a.
Integral a =>
MutablePrimArray RealWorld Word8 -> Int -> Int -> a -> IO ()
writePositiveDec MutablePrimArray RealWorld Word8
marr Int
off Int
n a
i                        -- digits

writePositiveDec :: (Integral a)
                => MutablePrimArray RealWorld Word8       -- ^ The buffer
                -> Int                                      -- ^ writing offset
                -> Int                                      -- ^ total digits
                -> a                                        -- ^ the value
                -> IO ()
{-# INLINE writePositiveDec #-}
writePositiveDec :: forall a.
Integral a =>
MutablePrimArray RealWorld Word8 -> Int -> Int -> a -> IO ()
writePositiveDec MutablePrimArray RealWorld Word8
marr Int
off0 Int
ds = Int -> a -> IO ()
go (Int
off0 forall a. Num a => a -> a -> a
+ Int
ds forall a. Num a => a -> a -> a
- Int
1)
  where
    go :: Int -> a -> IO ()
go Int
off a
v
        | a
v forall a. Ord a => a -> a -> Bool
>= a
100 = do
            let (a
q, a
r) = a
v forall a. Integral a => a -> a -> (a, a)
`quotRem` a
100
            Int -> a -> IO ()
write2 Int
off a
r
            Int -> a -> IO ()
go (Int
off forall a. Num a => a -> a -> a
- Int
2) a
q
        | a
v forall a. Ord a => a -> a -> Bool
< a
10    = forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld Word8
marr Int
off (forall a. Integral a => a -> Word8
i2wDec a
v)
        | Bool
otherwise = Int -> a -> IO ()
write2 Int
off a
v
    write2 :: Int -> a -> IO ()
write2 Int
off a
i0 = do
        let i :: Int
i = forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i0;
        forall (m :: * -> *) a.
(PrimMonad m, Unaligned a) =>
MutablePrimArray (PrimState m) Word8 -> Int -> a -> m ()
writePrimWord8ArrayAs MutablePrimArray RealWorld Word8
marr (Int
offforall a. Num a => a -> a -> a
-Int
1) forall a b. (a -> b) -> a -> b
$ forall a. Prim a => Ptr a -> Int -> a
indexOffPtr Ptr Word16
decDigitTable Int
i


--------------------------------------------------------------------------------
-- Below is an implementation of formatting integer, the main
-- idea is borrowed from base (GHC.Show).

#include "MachDeps.h"
#if SIZEOF_HSWORD == 4
#define DIGITS       9
#define BASE         1000000000
#elif SIZEOF_HSWORD == 8
#define DIGITS       18
#define BASE         1000000000000000000
#else
#error Please define DIGITS and BASE
-- DIGITS should be the largest integer such that
--     10^DIGITS < 2^(SIZEOF_HSWORD * 8 - 1)
-- BASE should be 10^DIGITS.
#endif

-- | Format a 'Integer' into decimal ASCII digits.
integer :: Integer -> Builder ()
{-# INLINE integer #-}
integer :: Integer -> Builder ()
integer (IS Int#
i#) = forall a. (Integral a, Bounded a) => a -> Builder ()
int (Int# -> Int
I# Int#
i#)
-- Divide and conquer implementation of string conversion
integer Integer
n0
    | Integer
n0 forall a. Ord a => a -> a -> Bool
< Integer
0    = forall a. Unaligned a => a -> Builder ()
encodePrim Word8
MINUS forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Integer -> Builder ()
integer' (-Integer
n0)
    | Bool
otherwise = Integer -> Builder ()
integer' Integer
n0
  where
    integer' :: Integer -> Builder ()
    integer' :: Integer -> Builder ()
integer' Integer
n
        | Integer
n forall a. Ord a => a -> a -> Bool
< BASE  = jhead (fromInteger n)
        | Bool
otherwise = [Integer] -> Builder ()
jprinth (Integer -> Integer -> [Integer]
jsplitf (BASE*BASE) n)

    -- Convert a number that has been split into digits in base BASE^2
    -- this includes a last splitting step and then conversion of digits
    -- that all fit into a machine word.
    jprinth :: [Integer] -> Builder ()
    jprinth :: [Integer] -> Builder ()
jprinth (Integer
n:[Integer]
ns) =
        case Integer
n Integer -> Integer -> (# Integer, Integer #)
`integerQuotRem#` BASE of
        (# Integer
q', Integer
r' #) ->
            let q :: Int
q = forall a. Num a => Integer -> a
fromInteger Integer
q'
                r :: Int
r = forall a. Num a => Integer -> a
fromInteger Integer
r'
            in if Int
q forall a. Ord a => a -> a -> Bool
> Int
0 then Int -> Builder ()
jhead Int
q forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Builder ()
jblock Int
r forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Integer] -> Builder ()
jprintb [Integer]
ns
                        else Int -> Builder ()
jhead Int
r forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Integer] -> Builder ()
jprintb [Integer]
ns
    jprinth [] = forall a. String -> a
errorWithoutStackTrace String
"jprinth []"

    jprintb :: [Integer] -> Builder ()
    jprintb :: [Integer] -> Builder ()
jprintb []     = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    jprintb (Integer
n:[Integer]
ns) = case Integer
n Integer -> Integer -> (# Integer, Integer #)
`integerQuotRem#` BASE of
                        (# Integer
q', Integer
r' #) ->
                            let q :: Int
q = forall a. Num a => Integer -> a
fromInteger Integer
q'
                                r :: Int
r = forall a. Num a => Integer -> a
fromInteger Integer
r'
                            in Int -> Builder ()
jblock Int
q forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Builder ()
jblock Int
r forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Integer] -> Builder ()
jprintb [Integer]
ns

    -- Convert an integer that fits into a machine word. Again, we have two
    -- functions, one that drops leading zeros (jhead) and one that doesn't
    -- (jblock)
    jhead :: Int -> Builder ()
    jhead :: Int -> Builder ()
jhead = forall a. (Integral a, Bounded a) => a -> Builder ()
int
    jblock :: Int -> Builder ()
    jblock :: Int -> Builder ()
jblock = forall a. (Integral a, Bounded a) => IFormat -> a -> Builder ()
intWith IFormat
defaultIFormat{padding :: Padding
padding = Padding
ZeroPadding, width :: Int
width=DIGITS}

    -- Split n into digits in base p. We first split n into digits
    -- in base p*p and then split each of these digits into two.
    -- Note that the first 'digit' modulo p*p may have a leading DIGIT_0
    -- in base p that we need to drop - this is what jsplith takes care of.
    -- jsplitb the handles the remaining digits.
    jsplitf :: Integer -> Integer -> [Integer]
    jsplitf :: Integer -> Integer -> [Integer]
jsplitf Integer
p Integer
n
        | Integer
p forall a. Ord a => a -> a -> Bool
> Integer
n     = [Integer
n]
        | Bool
otherwise = Integer -> [Integer] -> [Integer]
jsplith Integer
p (Integer -> Integer -> [Integer]
jsplitf (Integer
pforall a. Num a => a -> a -> a
*Integer
p) Integer
n)

    jsplith :: Integer -> [Integer] -> [Integer]
    jsplith :: Integer -> [Integer] -> [Integer]
jsplith Integer
p (Integer
n:[Integer]
ns) =
        case Integer
n Integer -> Integer -> (# Integer, Integer #)
`integerQuotRem#` Integer
p of
        (# Integer
q, Integer
r #) ->
            if Integer
q forall a. Ord a => a -> a -> Bool
> Integer
0 then Integer
q forall a. a -> [a] -> [a]
: Integer
r forall a. a -> [a] -> [a]
: Integer -> [Integer] -> [Integer]
jsplitb Integer
p [Integer]
ns
                     else     Integer
r forall a. a -> [a] -> [a]
: Integer -> [Integer] -> [Integer]
jsplitb Integer
p [Integer]
ns
    jsplith Integer
_ [] = forall a. String -> a
errorWithoutStackTrace String
"jsplith: []"

    jsplitb :: Integer -> [Integer] -> [Integer]
    jsplitb :: Integer -> [Integer] -> [Integer]
jsplitb Integer
_ []     = []
    jsplitb Integer
p (Integer
n:[Integer]
ns) = case Integer
n Integer -> Integer -> (# Integer, Integer #)
`integerQuotRem#` Integer
p of
                       (# Integer
q, Integer
r #) ->
                           Integer
q forall a. a -> [a] -> [a]
: Integer
r forall a. a -> [a] -> [a]
: Integer -> [Integer] -> [Integer]
jsplitb Integer
p [Integer]
ns

--------------------------------------------------------------------------------

-- | Count how many decimal digits an integer has.
countDigits :: (Integral a) => a -> Int
{-# INLINE countDigits #-}
countDigits :: forall a. Integral a => a -> Int
countDigits a
v0
  | forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
v64 forall a. Eq a => a -> a -> Bool
== a
v0 = forall {t}. Num t => t -> Word64 -> t
go Int
1 Word64
v64
  | Bool
otherwise              = Int -> Integer -> Int
goBig Int
1 (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
v0)
  where v64 :: Word64
v64 = forall a b. (Integral a, Num b) => a -> b
fromIntegral a
v0
        goBig :: Int -> Integer -> Int
goBig !Int
k (Integer
v :: Integer)
           | Integer
v forall a. Ord a => a -> a -> Bool
> Integer
big   = Int -> Integer -> Int
goBig (Int
k forall a. Num a => a -> a -> a
+ Int
19) (Integer
v forall a. Integral a => a -> a -> a
`quot` Integer
big)
           | Bool
otherwise = forall {t}. Num t => t -> Word64 -> t
go Int
k (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
v)
        big :: Integer
big = Integer
10000000000000000000
        go :: t -> Word64 -> t
go !t
k (Word64
v :: Word64)
           | Word64
v forall a. Ord a => a -> a -> Bool
< Word64
10    = t
k
           | Word64
v forall a. Ord a => a -> a -> Bool
< Word64
100   = t
k forall a. Num a => a -> a -> a
+ t
1
           | Word64
v forall a. Ord a => a -> a -> Bool
< Word64
1000  = t
k forall a. Num a => a -> a -> a
+ t
2
           | Word64
v forall a. Ord a => a -> a -> Bool
< Word64
1000000000000 =
               t
k forall a. Num a => a -> a -> a
+ if Word64
v forall a. Ord a => a -> a -> Bool
< Word64
100000000
                   then if Word64
v forall a. Ord a => a -> a -> Bool
< Word64
1000000
                        then if Word64
v forall a. Ord a => a -> a -> Bool
< Word64
10000
                             then t
3
                             else t
4 forall a. Num a => a -> a -> a
+ forall {a} {a}. (Ord a, Num a) => a -> a -> a
fin Word64
v Word64
100000
                        else t
6 forall a. Num a => a -> a -> a
+ forall {a} {a}. (Ord a, Num a) => a -> a -> a
fin Word64
v Word64
10000000
                   else if Word64
v forall a. Ord a => a -> a -> Bool
< Word64
10000000000
                        then t
8 forall a. Num a => a -> a -> a
+ forall {a} {a}. (Ord a, Num a) => a -> a -> a
fin Word64
v Word64
1000000000
                        else t
10 forall a. Num a => a -> a -> a
+ forall {a} {a}. (Ord a, Num a) => a -> a -> a
fin Word64
v Word64
100000000000
           | Bool
otherwise = t -> Word64 -> t
go (t
k forall a. Num a => a -> a -> a
+ t
12) (Word64
v forall a. Integral a => a -> a -> a
`quot` Word64
1000000000000)
        fin :: a -> a -> a
fin a
v a
n = if a
v forall a. Ord a => a -> a -> Bool
>= a
n then a
1 else a
0

-- | Decimal digit to ASCII digit.
i2wDec :: (Integral a) => a -> Word8
{-# INLINABLE i2wDec #-}
{-# SPECIALIZE INLINE i2wDec :: Int -> Word8 #-}
i2wDec :: forall a. Integral a => a -> Word8
i2wDec a
v = Word8
DIGIT_0 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral a
v

-- | Hexadecimal digit to ASCII char.
i2wHex :: (Integral a) => a -> Word8
{-# INLINABLE i2wHex #-}
{-# SPECIALIZE INLINE i2wHex :: Int -> Word8 #-}
i2wHex :: forall a. Integral a => a -> Word8
i2wHex a
v
    | a
v forall a. Ord a => a -> a -> Bool
<= a
9    = Word8
DIGIT_0 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral a
v
    | Bool
otherwise = Word8
87 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral a
v       -- fromEnum 'a' - 10

-- | Hexadecimal digit to UPPERCASED ASCII char.
i2wHexUpper :: (Integral a) => a -> Word8
{-# INLINABLE i2wHexUpper #-}
{-# SPECIALIZE INLINE i2wHexUpper :: Int -> Word8 #-}
i2wHexUpper :: forall a. Integral a => a -> Word8
i2wHexUpper a
v
    | a
v forall a. Ord a => a -> a -> Bool
<= a
9    = Word8
DIGIT_0 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral a
v
    | Bool
otherwise = Word8
55 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral a
v       -- fromEnum 'A' - 10

--------------------------------------------------------------------------------

-- | Format a 'FiniteBits' 'Integral' type into hex nibbles.
--
-- @
-- import Z.Data.Builder as B
-- import Z.Data.Text    as T
-- import Data.Word
-- import Data.Int
--
-- > T.validate . B.build $ B.hex (125 :: Int8)
-- "7d"
-- > T.validate . B.build $ B.hex (-1 :: Int8)
-- "ff"
-- > T.validate . B.build $ B.hex (125 :: Word16)
-- "007d"
-- @
--
hex :: forall a. (FiniteBits a, Integral a) => a -> Builder ()
{-# INLINABLE hex #-}
{-# SPECIALIZE INLINE hex :: Int -> Builder () #-}
{-# SPECIALIZE INLINE hex :: Int8 -> Builder () #-}
{-# SPECIALIZE INLINE hex :: Int16 -> Builder () #-}
{-# SPECIALIZE INLINE hex :: Int32 -> Builder () #-}
{-# SPECIALIZE INLINE hex :: Int64 -> Builder () #-}
{-# SPECIALIZE INLINE hex :: Word -> Builder () #-}
{-# SPECIALIZE INLINE hex :: Word8 -> Builder () #-}
{-# SPECIALIZE INLINE hex :: Word16 -> Builder () #-}
{-# SPECIALIZE INLINE hex :: Word32 -> Builder () #-}
{-# SPECIALIZE INLINE hex :: Word64 -> Builder () #-}
hex :: forall a. (FiniteBits a, Integral a) => a -> Builder ()
hex a
w = Int
-> (MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ()
writeN Int
hexSiz (forall {a} {m :: * -> *}.
(Integral a, PrimMonad m, Bits a) =>
a -> Int -> MutablePrimArray (PrimState m) Word8 -> Int -> m ()
go a
w (Int
hexSizforall a. Num a => a -> a -> a
-Int
2))
  where
    bitSiz :: Int
bitSiz = forall b. FiniteBits b => b -> Int
finiteBitSize (forall a. HasCallStack => a
undefined :: a)
    hexSiz :: Int
hexSiz = (Int
bitSizforall a. Num a => a -> a -> a
+Int
3) forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
2
    go :: a -> Int -> MutablePrimArray (PrimState m) Word8 -> Int -> m ()
go !a
v !Int
d MutablePrimArray (PrimState m) Word8
marr Int
off
        | Int
d forall a. Ord a => a -> a -> Bool
> Int
0 = do
            let !i :: Int
i = forall a b. (Integral a, Num b) => a -> b
fromIntegral a
v forall a. Bits a => a -> a -> a
.&. Int
0xFF; !j :: Int
j = Int
i forall a. Num a => a -> a -> a
+ Int
i
            forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray (PrimState m) Word8
marr (Int
off forall a. Num a => a -> a -> a
+ Int
d) forall a b. (a -> b) -> a -> b
$ forall a. Prim a => Ptr a -> Int -> a
indexOffPtr Ptr Word8
hexDigitTable Int
j
            forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray (PrimState m) Word8
marr (Int
off forall a. Num a => a -> a -> a
+ Int
d forall a. Num a => a -> a -> a
+ Int
1) forall a b. (a -> b) -> a -> b
$ forall a. Prim a => Ptr a -> Int -> a
indexOffPtr Ptr Word8
hexDigitTable (Int
jforall a. Num a => a -> a -> a
+Int
1)
            a -> Int -> MutablePrimArray (PrimState m) Word8 -> Int -> m ()
go (a
v forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
8) (Int
dforall a. Num a => a -> a -> a
-Int
2) MutablePrimArray (PrimState m) Word8
marr Int
off
        | Int
d forall a. Eq a => a -> a -> Bool
== Int
0 = do
            let !i :: Int
i = forall a b. (Integral a, Num b) => a -> b
fromIntegral a
v forall a. Bits a => a -> a -> a
.&. Int
0xFF; !j :: Int
j = Int
i forall a. Num a => a -> a -> a
+ Int
i
            forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray (PrimState m) Word8
marr Int
off forall a b. (a -> b) -> a -> b
$ forall a. Prim a => Ptr a -> Int -> a
indexOffPtr Ptr Word8
hexDigitTable Int
j
            forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray (PrimState m) Word8
marr (Int
off forall a. Num a => a -> a -> a
+ Int
1) forall a b. (a -> b) -> a -> b
$ forall a. Prim a => Ptr a -> Int -> a
indexOffPtr Ptr Word8
hexDigitTable (Int
jforall a. Num a => a -> a -> a
+Int
1)
        | Bool
otherwise = do         -- for FiniteBits instances which has extra bits
            let !i :: Int
i = forall a b. (Integral a, Num b) => a -> b
fromIntegral a
v forall a. Bits a => a -> a -> a
.&. Int
0x0F :: Int
            forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray (PrimState m) Word8
marr Int
off forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> Word8
i2wHex Int
i


-- | The UPPERCASED version of 'hex'.
hexUpper :: forall a. (FiniteBits a, Integral a) => a -> Builder ()
{-# INLINABLE hexUpper #-}
{-# SPECIALIZE INLINE hexUpper :: Int -> Builder () #-}
{-# SPECIALIZE INLINE hexUpper :: Int8 -> Builder () #-}
{-# SPECIALIZE INLINE hexUpper :: Int16 -> Builder () #-}
{-# SPECIALIZE INLINE hexUpper :: Int32 -> Builder () #-}
{-# SPECIALIZE INLINE hexUpper :: Int64 -> Builder () #-}
{-# SPECIALIZE INLINE hexUpper :: Word -> Builder () #-}
{-# SPECIALIZE INLINE hexUpper :: Word8 -> Builder () #-}
{-# SPECIALIZE INLINE hexUpper :: Word16 -> Builder () #-}
{-# SPECIALIZE INLINE hexUpper :: Word32 -> Builder () #-}
{-# SPECIALIZE INLINE hexUpper :: Word64 -> Builder () #-}
hexUpper :: forall a. (FiniteBits a, Integral a) => a -> Builder ()
hexUpper a
w = Int
-> (MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ()
writeN Int
hexSiz (forall {a} {m :: * -> *}.
(Integral a, PrimMonad m, Bits a) =>
a -> Int -> MutablePrimArray (PrimState m) Word8 -> Int -> m ()
go a
w (Int
hexSizforall a. Num a => a -> a -> a
-Int
2))
  where
    bitSiz :: Int
bitSiz = forall b. FiniteBits b => b -> Int
finiteBitSize (forall a. HasCallStack => a
undefined :: a)
    hexSiz :: Int
hexSiz = (Int
bitSizforall a. Num a => a -> a -> a
+Int
3) forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
2
    go :: a -> Int -> MutablePrimArray (PrimState m) Word8 -> Int -> m ()
go !a
v !Int
d MutablePrimArray (PrimState m) Word8
marr Int
off
        | Int
d forall a. Ord a => a -> a -> Bool
> Int
0 = do
            let !i :: Int
i = forall a b. (Integral a, Num b) => a -> b
fromIntegral a
v forall a. Bits a => a -> a -> a
.&. Int
0xFF; !j :: Int
j = Int
i forall a. Num a => a -> a -> a
+ Int
i
            forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray (PrimState m) Word8
marr (Int
off forall a. Num a => a -> a -> a
+ Int
d) forall a b. (a -> b) -> a -> b
$ forall a. Prim a => Ptr a -> Int -> a
indexOffPtr Ptr Word8
hexDigitTableUpper Int
j
            forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray (PrimState m) Word8
marr (Int
off forall a. Num a => a -> a -> a
+ Int
d forall a. Num a => a -> a -> a
+ Int
1) forall a b. (a -> b) -> a -> b
$ forall a. Prim a => Ptr a -> Int -> a
indexOffPtr Ptr Word8
hexDigitTableUpper (Int
jforall a. Num a => a -> a -> a
+Int
1)
            a -> Int -> MutablePrimArray (PrimState m) Word8 -> Int -> m ()
go (a
v forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
8) (Int
dforall a. Num a => a -> a -> a
-Int
2) MutablePrimArray (PrimState m) Word8
marr Int
off
        | Int
d forall a. Eq a => a -> a -> Bool
== Int
0 = do
            let !i :: Int
i = forall a b. (Integral a, Num b) => a -> b
fromIntegral a
v forall a. Bits a => a -> a -> a
.&. Int
0xFF; !j :: Int
j = Int
i forall a. Num a => a -> a -> a
+ Int
i
            forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray (PrimState m) Word8
marr Int
off forall a b. (a -> b) -> a -> b
$ forall a. Prim a => Ptr a -> Int -> a
indexOffPtr Ptr Word8
hexDigitTableUpper Int
j
            forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray (PrimState m) Word8
marr (Int
off forall a. Num a => a -> a -> a
+ Int
1) forall a b. (a -> b) -> a -> b
$ forall a. Prim a => Ptr a -> Int -> a
indexOffPtr Ptr Word8
hexDigitTableUpper (Int
jforall a. Num a => a -> a -> a
+Int
1)
        | Bool
otherwise = do         -- for FiniteBits instances which has extra bits
            let !i :: Int
i = forall a b. (Integral a, Num b) => a -> b
fromIntegral a
v forall a. Bits a => a -> a -> a
.&. Int
0x0F :: Int
            forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray (PrimState m) Word8
marr Int
off forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> Word8
i2wHexUpper Int
i

--------------------------------------------------------------------------------

-- Floating point numbers
-------------------------

-- | Control the rendering of floating point numbers.
data FFormat = 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 -> FFormat
FFormat -> Int
FFormat -> [FFormat]
FFormat -> FFormat
FFormat -> FFormat -> [FFormat]
FFormat -> FFormat -> FFormat -> [FFormat]
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 :: FFormat -> FFormat -> FFormat -> [FFormat]
$cenumFromThenTo :: FFormat -> FFormat -> FFormat -> [FFormat]
enumFromTo :: FFormat -> FFormat -> [FFormat]
$cenumFromTo :: FFormat -> FFormat -> [FFormat]
enumFromThen :: FFormat -> FFormat -> [FFormat]
$cenumFromThen :: FFormat -> FFormat -> [FFormat]
enumFrom :: FFormat -> [FFormat]
$cenumFrom :: FFormat -> [FFormat]
fromEnum :: FFormat -> Int
$cfromEnum :: FFormat -> Int
toEnum :: Int -> FFormat
$ctoEnum :: Int -> FFormat
pred :: FFormat -> FFormat
$cpred :: FFormat -> FFormat
succ :: FFormat -> FFormat
$csucc :: FFormat -> FFormat
Enum, ReadPrec [FFormat]
ReadPrec FFormat
Int -> ReadS FFormat
ReadS [FFormat]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FFormat]
$creadListPrec :: ReadPrec [FFormat]
readPrec :: ReadPrec FFormat
$creadPrec :: ReadPrec FFormat
readList :: ReadS [FFormat]
$creadList :: ReadS [FFormat]
readsPrec :: Int -> ReadS FFormat
$creadsPrec :: Int -> ReadS FFormat
Read, Int -> FFormat -> ShowS
[FFormat] -> ShowS
FFormat -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FFormat] -> ShowS
$cshowList :: [FFormat] -> ShowS
show :: FFormat -> String
$cshow :: FFormat -> String
showsPrec :: Int -> FFormat -> ShowS
$cshowsPrec :: Int -> FFormat -> ShowS
Show)


-- | Decimal encoding of an IEEE 'Float'.
--
-- Using standard decimal notation for arguments whose absolute value lies
-- between @0.1@ and @9,999,999@, and scientific notation otherwise.
float :: Float -> Builder ()
{-# INLINE float #-}
float :: Float -> Builder ()
float = FFormat -> Maybe Int -> Float -> Builder ()
floatWith FFormat
Generic forall a. Maybe a
Nothing

-- | Decimal encoding of an IEEE 'Double'.
--
-- Using standard decimal notation for arguments whose absolute value lies
-- between @0.1@ and @9,999,999@, and scientific notation otherwise.
double :: Double -> Builder ()
{-# INLINE double #-}
double :: Double -> Builder ()
double = FFormat -> Maybe Int -> Double -> Builder ()
doubleWith FFormat
Generic forall a. Maybe a
Nothing

-- | Format single-precision float using drisu3 with dragon4 fallback.
floatWith :: FFormat
          -> Maybe Int  -- ^ Number of decimal places to render.
          -> Float
          -> Builder ()
{-# INLINE floatWith #-}
floatWith :: FFormat -> Maybe Int -> Float -> Builder ()
floatWith FFormat
fmt Maybe Int
decs Float
x
    | forall a. RealFloat a => a -> Bool
isNaN Float
x                   = Builder ()
"NaN"
    | forall a. RealFloat a => a -> Bool
isInfinite Float
x              = if Float
x forall a. Ord a => a -> a -> Bool
< Float
0 then Builder ()
"-Infinity" else Builder ()
"Infinity"
    | Float
x forall a. Ord a => a -> a -> Bool
< Float
0                     = Char -> Builder ()
char8 Char
'-' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FFormat -> Maybe Int -> ([Int], Int) -> Builder ()
doFmt FFormat
fmt Maybe Int
decs (Float -> ([Int], Int)
grisu3_sp (-Float
x))
    | forall a. RealFloat a => a -> Bool
isNegativeZero Float
x          = Char -> Builder ()
char8 Char
'-' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FFormat -> Maybe Int -> ([Int], Int) -> Builder ()
doFmt FFormat
fmt Maybe Int
decs ([Int
0], Int
0)
    | Float
x forall a. Eq a => a -> a -> Bool
== Float
0                    = FFormat -> Maybe Int -> ([Int], Int) -> Builder ()
doFmt FFormat
fmt Maybe Int
decs ([Int
0], Int
0)
    | Bool
otherwise                 = FFormat -> Maybe Int -> ([Int], Int) -> Builder ()
doFmt FFormat
fmt Maybe Int
decs (Float -> ([Int], Int)
grisu3_sp Float
x) -- Grisu only handles strictly positive finite numbers.

-- | Format double-precision float using drisu3 with dragon4 fallback.
doubleWith :: FFormat
           -> Maybe Int  -- ^ Number of decimal places to render.
           -> Double
           -> Builder ()
{-# INLINE doubleWith #-}
doubleWith :: FFormat -> Maybe Int -> Double -> Builder ()
doubleWith FFormat
fmt Maybe Int
decs Double
x
    | forall a. RealFloat a => a -> Bool
isNaN Double
x                   = Builder ()
"NaN"
    | forall a. RealFloat a => a -> Bool
isInfinite Double
x              = if Double
x forall a. Ord a => a -> a -> Bool
< Double
0 then Builder ()
"-Infinity" else Builder ()
"Infinity"
    | Double
x forall a. Ord a => a -> a -> Bool
< Double
0                     = Char -> Builder ()
char8 Char
'-' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FFormat -> Maybe Int -> ([Int], Int) -> Builder ()
doFmt FFormat
fmt Maybe Int
decs (Double -> ([Int], Int)
grisu3 (-Double
x))
    | forall a. RealFloat a => a -> Bool
isNegativeZero Double
x          = Char -> Builder ()
char8 Char
'-' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FFormat -> Maybe Int -> ([Int], Int) -> Builder ()
doFmt FFormat
fmt Maybe Int
decs ([Int
0], Int
0)
    | Double
x forall a. Eq a => a -> a -> Bool
== Double
0                    = FFormat -> Maybe Int -> ([Int], Int) -> Builder ()
doFmt FFormat
fmt Maybe Int
decs ([Int
0], Int
0)
    | Bool
otherwise                 = FFormat -> Maybe Int -> ([Int], Int) -> Builder ()
doFmt FFormat
fmt Maybe Int
decs (Double -> ([Int], Int)
grisu3 Double
x) -- Grisu only handles strictly positive finite numbers.

-- | A faster version of 'Sci.toDecimalDigits' in case of small coefficient.
positiveSciToDigits :: Sci.Scientific -> ([Int], Int)
{-# INLINE positiveSciToDigits #-}
positiveSciToDigits :: Scientific -> ([Int], Int)
positiveSciToDigits Scientific
sci =
    if Integer
c forall a. Eq a => a -> a -> Bool
== Integer
0
    then ([Int
0], Int
0)
    else case Integer
c of
        (IS Int#
i#) -> Word -> Int -> [Int] -> ([Int], Int)
goI (Word# -> Word
W# (Int# -> Word#
int2Word# Int#
i#)) Int
0 []
        Integer
_ -> Integer -> Int -> [Int] -> ([Int], Int)
go Integer
c Int
0 []
  where
    sci' :: Scientific
sci' = Scientific -> Scientific
Sci.normalize Scientific
sci
    !c :: Integer
c = Scientific -> Integer
Sci.coefficient Scientific
sci'
    !e :: Int
e = Scientific -> Int
Sci.base10Exponent Scientific
sci'

    go :: Integer -> Int -> [Int] -> ([Int], Int)
    go :: Integer -> Int -> [Int] -> ([Int], Int)
go Integer
0 !Int
n [Int]
ds = let !ne :: Int
ne = Int
n forall a. Num a => a -> a -> a
+ Int
e in ([Int]
ds, Int
ne)
    go Integer
i !Int
n [Int]
ds = case Integer
i Integer -> Integer -> (# Integer, Integer #)
`integerQuotRem#` Integer
10 of
                     (# Integer
q, Integer
r #) -> let !d :: Int
d = forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
r in Integer -> Int -> [Int] -> ([Int], Int)
go Integer
q (Int
nforall a. Num a => a -> a -> a
+Int
1) (Int
dforall a. a -> [a] -> [a]
:[Int]
ds)
    goI :: Word -> Int -> [Int] -> ([Int], Int)
    goI :: Word -> Int -> [Int] -> ([Int], Int)
goI Word
0 !Int
n [Int]
ds = let !ne :: Int
ne = Int
n forall a. Num a => a -> a -> a
+ Int
e in ([Int]
ds, Int
ne)
    goI Word
i !Int
n [Int]
ds = case Word -> (Word, Word)
quotRem10 Word
i of (Word
q, Word
r) -> let !d :: Int
d = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
r in Word -> Int -> [Int] -> ([Int], Int)
goI Word
q (Int
nforall a. Num a => a -> a -> a
+Int
1) (Int
dforall a. a -> [a] -> [a]
:[Int]
ds)

-- | A faster `quotRem` by 10.
quotRem10 :: Word -> (Word, Word)
{-# INLINE quotRem10 #-}
quotRem10 :: Word -> (Word, Word)
quotRem10 (W# Word#
w#) =
    let w'# :: Word#
w'# = Word# -> Word#
dquot10# Word#
w#
    in (Word# -> Word
W# Word#
w'#, Word# -> Word
W# (Word#
w# Word# -> Word# -> Word#
`minusWord#` (Word#
w'# Word# -> Word# -> Word#
`timesWord#` Word#
10##)))
  where
    dquot10# :: Word# -> Word#
    dquot10# :: Word# -> Word#
dquot10# Word#
w =
        let !(# Word#
rdx, Word#
_ #) = Word#
w Word# -> Word# -> (# Word#, Word# #)
`timesWord2#` Word#
0xCCCCCCCCCCCCCCCD##
        in Word#
rdx Word# -> Int# -> Word#
`uncheckedShiftRL#` Int#
3#

-- | Worker function to do formatting.
doFmt :: FFormat
      -> Maybe Int -- ^ Number of decimal places to render.
      -> ([Int], Int) -- ^ List of digits and exponent
      -> Builder ()
{-# INLINABLE doFmt #-}
doFmt :: FFormat -> Maybe Int -> ([Int], Int) -> Builder ()
doFmt FFormat
format Maybe Int
decs ([Int]
is, Int
e) = case FFormat
format of
    FFormat
Generic -> 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 Builder ()
doFmtExponent else Builder ()
doFmtFixed
    FFormat
Exponent -> Builder ()
doFmtExponent
    FFormat
_ -> Builder ()
doFmtFixed
  where
    doFmtExponent :: Builder ()
doFmtExponent = case Maybe Int
decs of
        Maybe Int
Nothing -> case [Int]
is of
            [Int
0]     -> Builder ()
"0.0e0"
            [Int
i]     -> Int -> Builder ()
encodeDigit Int
i forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Builder ()
".0e" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. (Integral a, Bounded a) => a -> Builder ()
int (Int
eforall a. Num a => a -> a -> a
-Int
1)
            (Int
i:[Int]
is') -> do
                Int -> Builder ()
encodeDigit Int
i
                forall a. Unaligned a => a -> Builder ()
encodePrim Word8
DOT
                [Int] -> Builder ()
encodeDigits [Int]
is'
                forall a. Unaligned a => a -> Builder ()
encodePrim Word8
LETTER_e
                forall a. (Integral a, Bounded a) => a -> Builder ()
int (Int
eforall a. Num a => a -> a -> a
-Int
1)
            []      -> forall a. HasCallStack => String -> a
error String
"doFmt/Exponent: []"
        Just Int
dec
            | Int
dec forall a. Ord a => a -> a -> Bool
<= Int
0 ->
            -- decimal point as well (ghc trac #15115).
            -- Note that this handles negative precisions as well for consistency
            -- (see ghc trac #15509).
                case [Int]
is of
                    [Int
0] -> Builder ()
"0e0"
                    [Int]
_ -> do
                        let (Int
ei,[Int]
is') = Int -> Int -> [Int] -> (Int, [Int])
roundTo Int
10 Int
1 [Int]
is
                            Int
n:[Int]
_ = if Int
ei forall a. Ord a => a -> a -> Bool
> Int
0 then forall a. [a] -> [a]
List.init [Int]
is' else [Int]
is'
                        Int -> Builder ()
encodeDigit Int
n
                        forall a. Unaligned a => a -> Builder ()
encodePrim Word8
LETTER_e
                        forall a. (Integral a, Bounded a) => a -> Builder ()
int (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] -> do
                    Builder ()
"0." forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Builder ()
encodeZeros Int
dec' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Builder ()
"e0"
                [Int]
_ -> do
                    let (Int
ei,[Int]
is') = Int -> Int -> [Int] -> (Int, [Int])
roundTo Int
10 (Int
dec'forall a. Num a => a -> a -> a
+Int
1) [Int]
is
                        (Int
d:[Int]
ds') = if Int
ei forall a. Ord a => a -> a -> Bool
> Int
0 then forall a. [a] -> [a]
List.init [Int]
is' else [Int]
is'
                    Int -> Builder ()
encodeDigit Int
d
                    forall a. Unaligned a => a -> Builder ()
encodePrim Word8
DOT
                    [Int] -> Builder ()
encodeDigits [Int]
ds'
                    forall a. Unaligned a => a -> Builder ()
encodePrim Word8
LETTER_e
                    forall a. (Integral a, Bounded a) => a -> Builder ()
int (Int
eforall a. Num a => a -> a -> a
-Int
1forall a. Num a => a -> a -> a
+Int
ei)
    doFmtFixed :: Builder ()
doFmtFixed = case Maybe Int
decs of
        Maybe Int
Nothing
            | Int
e forall a. Ord a => a -> a -> Bool
<= Int
0    -> do
                Builder ()
"0."
                Int -> Builder ()
encodeZeros (-Int
e)
                [Int] -> Builder ()
encodeDigits [Int]
is
            | Bool
otherwise -> Int -> [Int] -> Builder ()
insertDot Int
e [Int]
is
        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 do
                    let (Int
ei,[Int]
is') = Int -> Int -> [Int] -> (Int, [Int])
roundTo Int
10 (Int
dec' forall a. Num a => a -> a -> a
+ Int
e) [Int]
is
                        ([Int]
ls,[Int]
rs)  = forall a. Int -> [a] -> ([a], [a])
splitAt (Int
eforall a. Num a => a -> a -> a
+Int
ei) [Int]
is'
                    [Int] -> Builder ()
mk0 [Int]
ls
                    (forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
List.null [Int]
rs) forall a b. (a -> b) -> a -> b
$ forall a. Unaligned a => a -> Builder ()
encodePrim Word8
DOT forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Int] -> Builder ()
encodeDigits [Int]
rs)
                else do
                    let (Int
ei,[Int]
is') = Int -> Int -> [Int] -> (Int, [Int])
roundTo Int
10 Int
dec' (forall a. Int -> a -> [a]
List.replicate (-Int
e) Int
0 forall a. [a] -> [a] -> [a]
++ [Int]
is)
                        Int
d:[Int]
ds' = if Int
ei forall a. Ord a => a -> a -> Bool
> Int
0 then [Int]
is' else Int
0forall a. a -> [a] -> [a]
:[Int]
is'
                    Int -> Builder ()
encodeDigit Int
d
                    (forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
List.null [Int]
ds') forall a b. (a -> b) -> a -> b
$ forall a. Unaligned a => a -> Builder ()
encodePrim Word8
DOT forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Int] -> Builder ()
encodeDigits [Int]
ds')

    encodeDigit :: Int -> Builder ()
encodeDigit = Word8 -> Builder ()
word8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => a -> Word8
i2wDec

    encodeDigits :: [Int] -> Builder ()
encodeDigits = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Int -> Builder ()
encodeDigit

    encodeZeros :: Int -> Builder ()
encodeZeros Int
n = Int -> Word8 -> Builder ()
word8N Int
n Word8
DIGIT_0

    mk0 :: [Int] -> Builder ()
mk0 [] = forall a. Unaligned a => a -> Builder ()
encodePrim Word8
DIGIT_0
    mk0 [Int]
ls = [Int] -> Builder ()
encodeDigits [Int]
ls

    insertDot :: Int -> [Int] -> Builder ()
insertDot Int
0     [Int]
rs = forall a. Unaligned a => a -> Builder ()
encodePrim Word8
DOT forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Int] -> Builder ()
mk0 [Int]
rs
    insertDot Int
n     [] = forall a. Unaligned a => a -> Builder ()
encodePrim Word8
DIGIT_0 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> [Int] -> Builder ()
insertDot (Int
nforall a. Num a => a -> a -> a
-Int
1) []
    insertDot Int
n (Int
r:[Int]
rs) = Int -> Builder ()
encodeDigit Int
r forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> [Int] -> Builder ()
insertDot (Int
nforall a. Num a => a -> a -> a
-Int
1) [Int]
rs

------------------------------------------------------------------------------

-- Conversion of 'Float's and 'Double's to ASCII in decimal using Grisu3
------------------------------------------------------------------------

#define GRISU3_SINGLE_BUF_LEN 10
#define GRISU3_DOUBLE_BUF_LEN 18

foreign import ccall unsafe "static grisu3" c_grisu3
    :: Double
    -> MBA# Word8   -- ^ char*
    -> MBA# Int     -- ^ Int
    -> MBA# Int     -- ^ Int
    -> IO Int

-- | Decimal encoding of a 'Double', note grisu only handles strictly positive finite numbers.
grisu3 :: Double -> ([Int], Int)
{-# INLINABLE grisu3 #-}
grisu3 :: Double -> ([Int], Int)
grisu3 Double
d = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
    (MutableByteArray MutableByteArray# RealWorld
pBuf) <- forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newByteArray GRISU3_DOUBLE_BUF_LEN
    (Int
len, (Int
e, Int
success)) <- forall a b.
Prim a =>
(MutableByteArray# RealWorld -> IO b) -> IO (a, b)
allocPrimUnsafe forall a b. (a -> b) -> a -> b
$ \ MutableByteArray# RealWorld
pLen ->
        forall a b.
Prim a =>
(MutableByteArray# RealWorld -> IO b) -> IO (a, b)
allocPrimUnsafe forall a b. (a -> b) -> a -> b
$ \ MutableByteArray# RealWorld
pE ->
            Double
-> MutableByteArray# RealWorld
-> MutableByteArray# RealWorld
-> MutableByteArray# RealWorld
-> IO Int
c_grisu3 (forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
d) MutableByteArray# RealWorld
pBuf MutableByteArray# RealWorld
pLen MutableByteArray# RealWorld
pE
    if Int
success forall a. Eq a => a -> a -> Bool
== Int
0 -- grisu3 fail
    then forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. RealFloat a => Integer -> a -> ([Int], Int)
floatToDigits Integer
10 Double
d)
    else do
        [Int]
buf <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Int
0..Int
lenforall a. Num a => a -> a -> a
-Int
1] forall a b. (a -> b) -> a -> b
$ \ Int
i -> do
            Word8
w8 <- forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
readByteArray (forall s. MutableByteArray# s -> MutableByteArray s
MutableByteArray MutableByteArray# RealWorld
pBuf) Int
i :: IO Word8
            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w8
        let !e' :: Int
e' = Int
e forall a. Num a => a -> a -> a
+ Int
len
        forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Int]
buf, Int
e')

foreign import ccall unsafe "static grisu3_sp" c_grisu3_sp
    :: Float
    -> MBA# Word8   -- ^ char*
    -> MBA# Int     -- ^ Int
    -> MBA# Int     -- ^ Int
    -> IO Int

-- | Decimal encoding of a 'Float', note grisu3_sp only handles strictly positive finite numbers.
grisu3_sp :: Float -> ([Int], Int)
{-# INLINABLE grisu3_sp #-}
grisu3_sp :: Float -> ([Int], Int)
grisu3_sp Float
d = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
    (MutableByteArray MutableByteArray# RealWorld
pBuf) <- forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newByteArray GRISU3_SINGLE_BUF_LEN
    (Int
len, (Int
e, Int
success)) <- forall a b.
Prim a =>
(MutableByteArray# RealWorld -> IO b) -> IO (a, b)
allocPrimUnsafe forall a b. (a -> b) -> a -> b
$ \ MutableByteArray# RealWorld
pLen ->
        forall a b.
Prim a =>
(MutableByteArray# RealWorld -> IO b) -> IO (a, b)
allocPrimUnsafe forall a b. (a -> b) -> a -> b
$ \ MutableByteArray# RealWorld
pE ->
            Float
-> MutableByteArray# RealWorld
-> MutableByteArray# RealWorld
-> MutableByteArray# RealWorld
-> IO Int
c_grisu3_sp (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
d) MutableByteArray# RealWorld
pBuf MutableByteArray# RealWorld
pLen MutableByteArray# RealWorld
pE
    if Int
success forall a. Eq a => a -> a -> Bool
== Int
0 -- grisu3 fail
    then forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. RealFloat a => Integer -> a -> ([Int], Int)
floatToDigits Integer
10 Float
d)
    else do
        [Int]
buf <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Int
0..Int
lenforall a. Num a => a -> a -> a
-Int
1] forall a b. (a -> b) -> a -> b
$ \ Int
i -> do
            Word8
w8 <- forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
readByteArray (forall s. MutableByteArray# s -> MutableByteArray s
MutableByteArray MutableByteArray# RealWorld
pBuf) Int
i :: IO Word8
            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w8
        let !e' :: Int
e' = Int
e forall a. Num a => a -> a -> a
+ Int
len
        forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Int]
buf, Int
e')

--------------------------------------------------------------------------------

-- | A @Builder@ which renders a scientific number to full
-- precision, using standard decimal notation for arguments whose
-- absolute value lies between @0.1@ and @9,999,999@, and scientific
-- notation otherwise.
scientific :: Sci.Scientific -> Builder ()
{-# INLINE scientific #-}
scientific :: Scientific -> Builder ()
scientific = FFormat -> Maybe Int -> Scientific -> Builder ()
scientificWith FFormat
Generic forall a. Maybe a
Nothing

-- | This builder try to avoid scientific notation when 0 <= exponent < 16.
--
scientific' :: Sci.Scientific -> Builder ()
{-# INLINE scientific' #-}
scientific' :: Scientific -> Builder ()
scientific' Scientific
s
    | Int
e forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
e forall a. Ord a => a -> a -> Bool
>= Int
16 = Scientific -> Builder ()
scientific Scientific
s
    | Int
e forall a. Eq a => a -> a -> Bool
== Int
0 = Integer -> Builder ()
integer Integer
c
    | Bool
otherwise = do
        Integer -> Builder ()
integer Integer
c
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
c forall a. Eq a => a -> a -> Bool
/= Integer
0) (forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
e (forall a. Unaligned a => a -> Builder ()
encodePrim Word8
DIGIT_0))
  where
    e :: Int
e = Scientific -> Int
Sci.base10Exponent Scientific
s
    c :: Integer
c = Scientific -> Integer
Sci.coefficient Scientific
s

-- | Like 'scientific' but provides rendering options.
scientificWith :: FFormat
               -> Maybe Int  -- ^ Number of decimal places to render.
               -> Sci.Scientific
               -> Builder ()
{-# INLINE scientificWith #-}
scientificWith :: FFormat -> Maybe Int -> Scientific -> Builder ()
scientificWith FFormat
fmt Maybe Int
decs Scientific
scntfc
   | Scientific
scntfc forall a. Ord a => a -> a -> Bool
< Scientific
0 = Char -> Builder ()
char8 Char
'-' forall a. Semigroup a => a -> a -> a
<> FFormat -> Maybe Int -> ([Int], Int) -> Builder ()
doFmt FFormat
fmt Maybe Int
decs (Scientific -> ([Int], Int)
positiveSciToDigits (-Scientific
scntfc))
   | Bool
otherwise  =              FFormat -> Maybe Int -> ([Int], Int) -> Builder ()
doFmt FFormat
fmt Maybe Int
decs (Scientific -> ([Int], Int)
positiveSciToDigits   Scientific
scntfc)