{-|
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
  , scientificWith
  -- * Misc
  , grisu3
  , grisu3_sp
  , i2wDec, i2wHex, i2wHexUpper
  , countDigits
  , c_intWith, hs_intWith
) 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.Integer
import           Z.Data.ASCII
import           Z.Data.Builder.Base
import           Z.Data.Builder.Numeric.DigitTable
import           Z.Foreign
import           System.IO.Unsafe
#ifdef INTEGER_GMP
import           GHC.Integer.GMP.Internals
#endif
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
(Int -> IFormat -> ShowS)
-> (IFormat -> String) -> ([IFormat] -> ShowS) -> Show IFormat
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
(IFormat -> IFormat -> Bool)
-> (IFormat -> IFormat -> Bool) -> Eq IFormat
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
Eq IFormat
-> (IFormat -> IFormat -> Ordering)
-> (IFormat -> IFormat -> Bool)
-> (IFormat -> IFormat -> Bool)
-> (IFormat -> IFormat -> Bool)
-> (IFormat -> IFormat -> Bool)
-> (IFormat -> IFormat -> IFormat)
-> (IFormat -> IFormat -> IFormat)
-> Ord 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
$cp1Ord :: Eq IFormat
Ord)

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

instance CoArbitrary IFormat where
    coarbitrary :: IFormat -> Gen b -> Gen b
coarbitrary (IFormat Int
w Padding
pad Bool
p) = (Int, Padding, Bool) -> Gen b -> Gen b
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

data Padding = NoPadding | RightSpacePadding | LeftSpacePadding | ZeroPadding deriving (Int -> Padding -> ShowS
[Padding] -> ShowS
Padding -> String
(Int -> Padding -> ShowS)
-> (Padding -> String) -> ([Padding] -> ShowS) -> Show Padding
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
(Padding -> Padding -> Bool)
-> (Padding -> Padding -> Bool) -> Eq Padding
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
Eq Padding
-> (Padding -> Padding -> Ordering)
-> (Padding -> Padding -> Bool)
-> (Padding -> Padding -> Bool)
-> (Padding -> Padding -> Bool)
-> (Padding -> Padding -> Bool)
-> (Padding -> Padding -> Padding)
-> (Padding -> Padding -> Padding)
-> Ord 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
$cp1Ord :: Eq Padding
Ord, Int -> Padding
Padding -> Int
Padding -> [Padding]
Padding -> Padding
Padding -> Padding -> [Padding]
Padding -> Padding -> Padding -> [Padding]
(Padding -> Padding)
-> (Padding -> Padding)
-> (Int -> Padding)
-> (Padding -> Int)
-> (Padding -> [Padding])
-> (Padding -> Padding -> [Padding])
-> (Padding -> Padding -> [Padding])
-> (Padding -> Padding -> Padding -> [Padding])
-> Enum 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 = Int -> Padding
forall a. Enum a => Int -> a
toEnum (Int -> Padding) -> (Int -> Int) -> Int -> Padding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
4) (Int -> Padding) -> Gen Int -> Gen Padding
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Int
forall a. Arbitrary a => Gen a
arbitrary

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

-- | @int = intWith defaultIFormat@
int :: (Integral a, Bounded a) => a -> Builder ()
{-# INLINE int #-}
int :: a -> Builder ()
int = IFormat -> a -> Builder ()
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
-- import Z.Data.Text    as T
--
-- > T.validate . B.buildBytes $ B.intWith defaultIFormat  (12345 :: Int)
-- "12345"
-- > T.validate . B.buildBytes $ B.intWith defaultIFormat{width=10, padding=RightSpacePadding} (12345 :: Int)
-- "12345     "
-- > T.validate . B.buildBytes $ B.intWith defaultIFormat{width=10, padding=ZeroPadding} (12345 :: Int)
-- "0000012345"
-- @
--
intWith :: (Integral a, Bounded a) => IFormat -> a -> Builder ()
intWith :: IFormat -> a -> Builder ()
intWith = IFormat -> a -> Builder ()
forall a. (Integral a, Bounded a) => IFormat -> a -> Builder ()
hs_intWith
{-# INLINE[0] intWith #-}
{-# RULES "intWith'/Int8"    intWith = c_intWith  :: IFormat -> Int8    -> Builder () #-}
{-# RULES "intWith'/Int"     intWith = c_intWith  :: IFormat -> Int     -> 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 () #-}

-- | 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 :: 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
    | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 =
        let !x' :: Word64
x' = (a -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> a
forall a. Bits a => a -> a
complement a
x) :: Word64) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1
        in Int
-> (MutablePrimArray RealWorld Word8 -> Int -> IO Int)
-> Builder ()
ensureN Int
width' (\ (MutablePrimArray MutableByteArray# RealWorld
mba#) Int
i ->
            (Word64
-> Int
-> Int
-> Word8
-> MutableByteArray# RealWorld
-> Int
-> IO Int
c_int_dec Word64
x' (-Int
1) Int
width Word8
pad (MutableByteArray# RealWorld -> MutableByteArray# RealWorld
unsafeCoerce# MutableByteArray# RealWorld
mba#) Int
i))
    | Bool
posSign =
        Int
-> (MutablePrimArray RealWorld Word8 -> Int -> IO Int)
-> Builder ()
ensureN Int
width' (\ (MutablePrimArray MutableByteArray# RealWorld
mba#) Int
i ->
            (Word64
-> Int
-> Int
-> Word8
-> MutableByteArray# RealWorld
-> Int
-> IO Int
c_int_dec (a -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x) Int
1 Int
width Word8
pad (MutableByteArray# RealWorld -> MutableByteArray# RealWorld
unsafeCoerce# MutableByteArray# RealWorld
mba#) Int
i))
    | Bool
otherwise =
        Int
-> (MutablePrimArray RealWorld Word8 -> Int -> IO Int)
-> Builder ()
ensureN Int
width' (\ (MutablePrimArray MutableByteArray# RealWorld
mba#) Int
i ->
            (Word64
-> Int
-> Int
-> Word8
-> MutableByteArray# RealWorld
-> Int
-> IO Int
c_int_dec (a -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x) Int
0 Int
width Word8
pad (MutableByteArray# RealWorld -> MutableByteArray# RealWorld
unsafeCoerce# MutableByteArray# RealWorld
mba#) Int
i))
  where
    width' :: Int
width' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
21 Int
width
    pad :: Word8
pad = case Padding
padding of Padding
NoPadding          -> Word8
0
                          Padding
RightSpacePadding  -> Word8
1
                          Padding
LeftSpacePadding   -> Word8
2
                          Padding
ZeroPadding        -> 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 :: 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 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 =
        if a
i a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Bounded a => a
minBound            -- can't directly negate in this case
        then do
            let (a
q, a
r) = a
i a -> a -> (a, a)
forall a. Integral a => a -> a -> (a, a)
`quotRem` a
10
                !qq :: a
qq = -a
q            -- all digits except last one
                !rr :: Word8
rr = a -> Word8
forall a. Integral a => a -> Word8
i2wDec (-a
r)      -- last digits
                !n :: Int
n = a -> Int
forall a. Integral a => a -> Int
countDigits a
qq
                !n' :: Int
n' = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2         -- extra two bytes: MINUS and last digit
            if Int
width Int -> Int -> Bool
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' ((MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ())
-> (MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ()
forall a b. (a -> b) -> a -> b
$ \MutablePrimArray RealWorld Word8
marr Int
off -> do
                        MutablePrimArray (PrimState IO) Word8 -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
marr Int
off Word8
MINUS                       -- leading MINUS
                        let off' :: Int
off' = Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                        MutablePrimArray RealWorld Word8 -> Int -> Int -> a -> IO ()
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' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n
                        MutablePrimArray (PrimState IO) Word8 -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
marr Int
off'' Word8
rr                        -- last digit
                Padding
ZeroPadding ->
                    Int
-> (MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ()
writeN Int
width ((MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ())
-> (MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ()
forall a b. (a -> b) -> a -> b
$ \MutablePrimArray RealWorld Word8
marr Int
off -> do
                        let !leadingN :: Int
leadingN = Int
widthInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
n'
                        MutablePrimArray (PrimState IO) Word8 -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
marr Int
off Word8
MINUS                   -- leading MINUS
                        let off' :: Int
off' = Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                        MutablePrimArray (PrimState IO) Word8
-> Int -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> Int -> a -> m ()
setPrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
marr Int
off' Int
leadingN Word8
DIGIT_0            -- leading zeros
                        let off'' :: Int
off'' = Int
off' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
leadingN
                        MutablePrimArray RealWorld Word8 -> Int -> Int -> a -> IO ()
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'' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n
                        MutablePrimArray (PrimState IO) Word8 -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
marr Int
off''' Word8
rr                   -- last digit
                Padding
LeftSpacePadding ->
                    Int
-> (MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ()
writeN Int
width ((MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ())
-> (MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ()
forall a b. (a -> b) -> a -> b
$ \MutablePrimArray RealWorld Word8
marr Int
off -> do
                        let !leadingN :: Int
leadingN = Int
widthInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
n'
                        MutablePrimArray (PrimState IO) Word8
-> Int -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> Int -> a -> m ()
setPrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
marr Int
off Int
leadingN Word8
SPACE            -- leading spaces
                        let off' :: Int
off' = Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
leadingN
                        MutablePrimArray (PrimState IO) Word8 -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
marr Int
off' Word8
MINUS                  -- leading MINUS
                        let off'' :: Int
off'' = Int
off' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                        MutablePrimArray RealWorld Word8 -> Int -> Int -> a -> IO ()
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'' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n
                        MutablePrimArray (PrimState IO) Word8 -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
marr Int
off''' Word8
rr                   -- last digit
                Padding
RightSpacePadding ->
                    Int
-> (MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ()
writeN Int
width ((MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ())
-> (MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ()
forall a b. (a -> b) -> a -> b
$ \MutablePrimArray RealWorld Word8
marr Int
off -> do
                        let !trailingN :: Int
trailingN = Int
widthInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
n'
                        MutablePrimArray (PrimState IO) Word8 -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
marr Int
off Word8
MINUS                   -- leading MINUS
                        let off' :: Int
off' = Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                        MutablePrimArray RealWorld Word8 -> Int -> Int -> a -> IO ()
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' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n
                        MutablePrimArray (PrimState IO) Word8 -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
marr Int
off'' Word8
rr                    -- last digit
                        let off''' :: Int
off''' = Int
off'' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                        MutablePrimArray (PrimState IO) Word8
-> Int -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> Int -> a -> m ()
setPrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
marr Int
off''' Int
trailingN Word8
SPACE        -- trailing spaces
            else
                Int
-> (MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ()
writeN Int
n' ((MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ())
-> (MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ()
forall a b. (a -> b) -> a -> b
$ \MutablePrimArray RealWorld Word8
marr Int
off -> do
                    MutablePrimArray (PrimState IO) Word8 -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
marr Int
off Word8
MINUS                       -- leading MINUS
                    let off' :: Int
off' = Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                    MutablePrimArray RealWorld Word8 -> Int -> Int -> a -> IO ()
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' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n
                    MutablePrimArray (PrimState IO) Word8 -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
marr Int
off'' Word8
rr                        -- last digit
        else do
            let !qq :: a
qq = -a
i
                !n :: Int
n = a -> Int
forall a. Integral a => a -> Int
countDigits a
qq
                !n' :: Int
n' = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1  -- extra byte: MINUS
            if Int
width Int -> Int -> Bool
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' ((MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ())
-> (MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ()
forall a b. (a -> b) -> a -> b
$ \MutablePrimArray RealWorld Word8
marr Int
off -> do
                        MutablePrimArray (PrimState IO) Word8 -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
marr Int
off Word8
MINUS                       -- leading MINUS
                        let off' :: Int
off' = Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                        MutablePrimArray RealWorld Word8 -> Int -> Int -> a -> IO ()
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 ((MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ())
-> (MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ()
forall a b. (a -> b) -> a -> b
$ \MutablePrimArray RealWorld Word8
marr Int
off -> do
                        let !leadingN :: Int
leadingN = Int
widthInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
n'
                        MutablePrimArray (PrimState IO) Word8 -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
marr Int
off Word8
MINUS                   -- leading MINUS
                        let off' :: Int
off' = Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                        MutablePrimArray (PrimState IO) Word8
-> Int -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> Int -> a -> m ()
setPrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
marr Int
off' Int
leadingN Word8
DIGIT_0            -- leading zeros
                        let off'' :: Int
off'' = Int
off' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
leadingN
                        MutablePrimArray RealWorld Word8 -> Int -> Int -> a -> IO ()
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 ((MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ())
-> (MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ()
forall a b. (a -> b) -> a -> b
$ \MutablePrimArray RealWorld Word8
marr Int
off -> do
                        let !leadingN :: Int
leadingN = Int
widthInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
n'
                        MutablePrimArray (PrimState IO) Word8
-> Int -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> Int -> a -> m ()
setPrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
marr Int
off Int
leadingN Word8
SPACE            -- leading spaces
                        let off' :: Int
off' = Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
leadingN
                        MutablePrimArray (PrimState IO) Word8 -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
marr Int
off' Word8
MINUS                  -- leading MINUS
                        let off'' :: Int
off'' = Int
off' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                        MutablePrimArray RealWorld Word8 -> Int -> Int -> a -> IO ()
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 ((MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ())
-> (MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ()
forall a b. (a -> b) -> a -> b
$ \MutablePrimArray RealWorld Word8
marr Int
off -> do
                        let !trailingN :: Int
trailingN = Int
widthInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
n'
                        MutablePrimArray (PrimState IO) Word8 -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
marr Int
off Word8
MINUS                   -- leading MINUS
                        let off' :: Int
off' = Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                        MutablePrimArray RealWorld Word8 -> Int -> Int -> a -> IO ()
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' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n
                        MutablePrimArray (PrimState IO) Word8
-> Int -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> Int -> a -> m ()
setPrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
marr Int
off'' Int
trailingN Word8
SPACE         -- trailing spaces
            else
                Int
-> (MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ()
writeN Int
n' ((MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ())
-> (MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ()
forall a b. (a -> b) -> a -> b
$ \MutablePrimArray RealWorld Word8
marr Int
off -> do
                    MutablePrimArray (PrimState IO) Word8 -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
marr Int
off Word8
MINUS                       -- leading MINUS
                    let off' :: Int
off' = Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                    MutablePrimArray RealWorld Word8 -> Int -> Int -> a -> IO ()
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 = IFormat -> a -> Builder ()
forall a. Integral a => IFormat -> a -> Builder ()
positiveInt IFormat
format a
i

positiveInt :: (Integral a) => IFormat -> a -> Builder ()
{-# INLINABLE positiveInt #-}
positiveInt :: IFormat -> a -> Builder ()
positiveInt (IFormat Int
width Padding
padding Bool
ps) a
i =
    let !n :: Int
n = a -> Int
forall a. Integral a => a -> Int
countDigits a
i
    in if Bool
ps
        then
            let n' :: Int
n' = Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1
            in if Int
width Int -> Int -> Bool
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' ((MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ())
-> (MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ()
forall a b. (a -> b) -> a -> b
$ \MutablePrimArray RealWorld Word8
marr Int
off -> do
                        MutablePrimArray (PrimState IO) Word8 -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
marr Int
off Word8
PLUS                    -- leading PLUS
                        let off' :: Int
off' = Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                        MutablePrimArray RealWorld Word8 -> Int -> Int -> a -> IO ()
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 ((MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ())
-> (MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ()
forall a b. (a -> b) -> a -> b
$ \MutablePrimArray RealWorld Word8
marr Int
off -> do
                        let !leadingN :: Int
leadingN = Int
widthInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
n'
                        MutablePrimArray (PrimState IO) Word8 -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
marr Int
off Word8
PLUS                    -- leading PLUS
                        let off' :: Int
off' = Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                        MutablePrimArray (PrimState IO) Word8
-> Int -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> Int -> a -> m ()
setPrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
marr Int
off' Int
leadingN Word8
DIGIT_0            -- leading zeros
                        let off'' :: Int
off'' = Int
off' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
leadingN
                        MutablePrimArray RealWorld Word8 -> Int -> Int -> a -> IO ()
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 ((MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ())
-> (MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ()
forall a b. (a -> b) -> a -> b
$ \MutablePrimArray RealWorld Word8
marr Int
off -> do
                        let !leadingN :: Int
leadingN = Int
widthInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
n'
                        MutablePrimArray (PrimState IO) Word8
-> Int -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> Int -> a -> m ()
setPrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
marr Int
off Int
leadingN Word8
SPACE            -- leading spaces
                        let off' :: Int
off' = Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
leadingN
                        MutablePrimArray (PrimState IO) Word8 -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
marr Int
off' Word8
PLUS                   -- leading PLUS
                        let off'' :: Int
off'' = Int
off' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                        MutablePrimArray RealWorld Word8 -> Int -> Int -> a -> IO ()
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 ((MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ())
-> (MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ()
forall a b. (a -> b) -> a -> b
$ \MutablePrimArray RealWorld Word8
marr Int
off -> do
                        let !trailingN :: Int
trailingN = Int
widthInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
n'
                        MutablePrimArray (PrimState IO) Word8 -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
marr Int
off Word8
PLUS                    -- leading PLUS
                        let off' :: Int
off' = Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                        MutablePrimArray RealWorld Word8 -> Int -> Int -> a -> IO ()
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' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n
                        MutablePrimArray (PrimState IO) Word8
-> Int -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> Int -> a -> m ()
setPrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
marr Int
off'' Int
trailingN Word8
SPACE         -- trailing spaces
            else
                Int
-> (MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ()
writeN Int
n' ((MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ())
-> (MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ()
forall a b. (a -> b) -> a -> b
$ \MutablePrimArray RealWorld Word8
marr Int
off -> do
                    MutablePrimArray (PrimState IO) Word8 -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
marr Int
off Word8
PLUS                        -- leading PLUS
                    let off' :: Int
off' = Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                    MutablePrimArray RealWorld Word8 -> Int -> Int -> a -> IO ()
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 Int -> Int -> Bool
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 ((MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ())
-> (MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ()
forall a b. (a -> b) -> a -> b
$ \MutablePrimArray RealWorld Word8
marr Int
off -> do
                        MutablePrimArray RealWorld Word8 -> Int -> Int -> a -> IO ()
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 ((MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ())
-> (MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ()
forall a b. (a -> b) -> a -> b
$ \MutablePrimArray RealWorld Word8
marr Int
off -> do
                        let !leadingN :: Int
leadingN = Int
widthInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
n
                        MutablePrimArray (PrimState IO) Word8
-> Int -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> Int -> a -> m ()
setPrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
marr Int
off Int
leadingN Word8
DIGIT_0             -- leading zeros
                        let off' :: Int
off' = Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
leadingN
                        MutablePrimArray RealWorld Word8 -> Int -> Int -> a -> IO ()
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 ((MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ())
-> (MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ()
forall a b. (a -> b) -> a -> b
$ \MutablePrimArray RealWorld Word8
marr Int
off -> do
                        let !leadingN :: Int
leadingN = Int
widthInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
n
                        MutablePrimArray (PrimState IO) Word8
-> Int -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> Int -> a -> m ()
setPrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
marr Int
off Int
leadingN Word8
SPACE            -- leading spaces
                        let off' :: Int
off' = Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
leadingN
                        MutablePrimArray RealWorld Word8 -> Int -> Int -> a -> IO ()
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 ((MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ())
-> (MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ()
forall a b. (a -> b) -> a -> b
$ \MutablePrimArray RealWorld Word8
marr Int
off -> do
                        let !trailingN :: Int
trailingN = Int
widthInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
n
                        MutablePrimArray RealWorld Word8 -> Int -> Int -> a -> IO ()
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n
                        MutablePrimArray (PrimState IO) Word8
-> Int -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> Int -> a -> m ()
setPrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
marr Int
off' Int
trailingN Word8
SPACE          -- trailing spaces
            else
                Int
-> (MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ()
writeN Int
n ((MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ())
-> (MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ()
forall a b. (a -> b) -> a -> b
$ \MutablePrimArray RealWorld Word8
marr Int
off -> do
                    MutablePrimArray RealWorld Word8 -> Int -> Int -> a -> IO ()
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 :: MutablePrimArray RealWorld Word8 -> Int -> Int -> a -> IO ()
writePositiveDec MutablePrimArray RealWorld Word8
marr Int
off0 Int
ds = Int -> a -> IO ()
go (Int
off0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ds Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
  where
    go :: Int -> a -> IO ()
go Int
off a
v
        | a
v a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
100 = do
            let (a
q, a
r) = a
v a -> a -> (a, a)
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) a
q
        | a
v a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
10    = MutablePrimArray (PrimState IO) Word8 -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
marr Int
off (a -> Word8
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 = a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i0; j :: Int
j = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i
        MutablePrimArray (PrimState IO) Word8 -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
marr Int
off (Word8 -> IO ()) -> Word8 -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Word8 -> Int -> Word8
forall a. Prim a => Ptr a -> Int -> a
indexOffPtr Ptr Word8
decDigitTable (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        MutablePrimArray (PrimState IO) Word8 -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
marr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Word8 -> IO ()) -> Word8 -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Word8 -> Int -> Word8
forall a. Prim a => Ptr a -> Int -> a
indexOffPtr Ptr Word8
decDigitTable Int
j


--------------------------------------------------------------------------------
-- 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 #-}
#ifdef INTEGER_GMP
integer :: Integer -> Builder ()
integer (S# Int#
i#) = Int -> Builder ()
forall a. (Integral a, Bounded a) => a -> Builder ()
int (Int# -> Int
I# Int#
i#)
#endif
-- Divide and conquer implementation of string conversion
integer Integer
n0
    | Integer
n0 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0    = Word8 -> Builder ()
forall a. Unaligned a => a -> Builder ()
encodePrim Word8
MINUS Builder () -> Builder () -> Builder ()
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 Integer -> Integer -> Bool
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 #)
`quotRemInteger` BASE of
        (# Integer
q', Integer
r' #) ->
            let q :: Int
q = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
q'
                r :: Int
r = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
r'
            in if Int
q Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then Int -> Builder ()
jhead Int
q Builder () -> Builder () -> Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Builder ()
jblock Int
r Builder () -> Builder () -> Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Integer] -> Builder ()
jprintb [Integer]
ns
                        else Int -> Builder ()
jhead Int
r Builder () -> Builder () -> Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Integer] -> Builder ()
jprintb [Integer]
ns
    jprinth [] = String -> Builder ()
forall a. String -> a
errorWithoutStackTrace String
"jprinth []"

    jprintb :: [Integer] -> Builder ()
    jprintb :: [Integer] -> Builder ()
jprintb []     = () -> Builder ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    jprintb (Integer
n:[Integer]
ns) = case Integer
n Integer -> Integer -> (# Integer, Integer #)
`quotRemInteger` BASE of
                        (# Integer
q', Integer
r' #) ->
                            let q :: Int
q = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
q'
                                r :: Int
r = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
r'
                            in Int -> Builder ()
jblock Int
q Builder () -> Builder () -> Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Builder ()
jblock Int
r Builder () -> Builder () -> Builder ()
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 = Int -> Builder ()
forall a. (Integral a, Bounded a) => a -> Builder ()
int
    jblock :: Int -> Builder ()
    jblock :: Int -> Builder ()
jblock = IFormat -> Int -> Builder ()
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 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
n     = [Integer
n]
        | Bool
otherwise = Integer -> [Integer] -> [Integer]
jsplith Integer
p (Integer -> Integer -> [Integer]
jsplitf (Integer
pInteger -> Integer -> Integer
forall 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 #)
`quotRemInteger` Integer
p of
        (# Integer
q, Integer
r #) ->
            if Integer
q Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 then Integer
q Integer -> [Integer] -> [Integer]
forall k1. k1 -> [k1] -> [k1]
: Integer
r Integer -> [Integer] -> [Integer]
forall k1. k1 -> [k1] -> [k1]
: Integer -> [Integer] -> [Integer]
jsplitb Integer
p [Integer]
ns
                     else     Integer
r Integer -> [Integer] -> [Integer]
forall k1. k1 -> [k1] -> [k1]
: Integer -> [Integer] -> [Integer]
jsplitb Integer
p [Integer]
ns
    jsplith Integer
_ [] = String -> [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 #)
`quotRemInteger` Integer
p of
                       (# Integer
q, Integer
r #) ->
                           Integer
q Integer -> [Integer] -> [Integer]
forall k1. k1 -> [k1] -> [k1]
: Integer
r Integer -> [Integer] -> [Integer]
forall k1. k1 -> [k1] -> [k1]
: Integer -> [Integer] -> [Integer]
jsplitb Integer
p [Integer]
ns

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

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

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

-- | Hexadecimal digit to ASCII char.
i2wHex :: (Integral a) => a -> Word8
{-# INLINE i2wHex #-}
{-# SPECIALIZE INLINE i2wHex :: Int -> Word8 #-}
i2wHex :: a -> Word8
i2wHex a
v
    | a
v a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
9    = Word8
DIGIT_0 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ a -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
v
    | Bool
otherwise = Word8
87 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ a -> Word8
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
{-# INLINE i2wHexUpper #-}
{-# SPECIALIZE INLINE i2wHexUpper :: Int -> Word8 #-}
i2wHexUpper :: a -> Word8
i2wHexUpper a
v
    | a
v a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
9    = Word8
DIGIT_0 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ a -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
v
    | Bool
otherwise = Word8
55 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ a -> Word8
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.buildBytes $ B.hex (125 :: Int8)
-- "7d"
-- > T.validate . B.buildBytes $ B.hex (-1 :: Int8)
-- "ff"
-- > T.validate . B.buildBytes $ B.hex (125 :: Word16)
-- "007d"
-- @
--
hex :: forall a. (FiniteBits a, Integral a) => a -> Builder ()
{-# INLINE hex #-}
hex :: a -> Builder ()
hex a
w = Int
-> (MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ()
writeN Int
hexSiz (a -> Int -> MutablePrimArray (PrimState IO) Word8 -> Int -> IO ()
forall a (m :: * -> *).
(Integral a, PrimMonad m, Bits a) =>
a -> Int -> MutablePrimArray (PrimState m) Word8 -> Int -> m ()
go a
w (Int
hexSizInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2))
  where
    bitSiz :: Int
bitSiz = a -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize (a
forall a. HasCallStack => a
undefined :: a)
    hexSiz :: Int
hexSiz = (Int
bitSizInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
3) Int -> Int -> Int
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = do
            let !i :: Int
i = a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
v Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xFF; !j :: Int
j = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i
            MutablePrimArray (PrimState m) Word8 -> Int -> Word8 -> m ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray (PrimState m) Word8
marr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
d) (Word8 -> m ()) -> Word8 -> m ()
forall a b. (a -> b) -> a -> b
$ Ptr Word8 -> Int -> Word8
forall a. Prim a => Ptr a -> Int -> a
indexOffPtr Ptr Word8
hexDigitTable Int
j
            MutablePrimArray (PrimState m) Word8 -> Int -> Word8 -> m ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray (PrimState m) Word8
marr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Word8 -> m ()) -> Word8 -> m ()
forall a b. (a -> b) -> a -> b
$ Ptr Word8 -> Int -> Word8
forall a. Prim a => Ptr a -> Int -> a
indexOffPtr Ptr Word8
hexDigitTable (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
            a -> Int -> MutablePrimArray (PrimState m) Word8 -> Int -> m ()
go (a
v a -> Int -> a
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
8) (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2) MutablePrimArray (PrimState m) Word8
marr Int
off
        | Int
d Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = do
            let !i :: Int
i = a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
v Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xFF; !j :: Int
j = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i
            MutablePrimArray (PrimState m) Word8 -> Int -> Word8 -> m ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray (PrimState m) Word8
marr Int
off (Word8 -> m ()) -> Word8 -> m ()
forall a b. (a -> b) -> a -> b
$ Ptr Word8 -> Int -> Word8
forall a. Prim a => Ptr a -> Int -> a
indexOffPtr Ptr Word8
hexDigitTable Int
j
            MutablePrimArray (PrimState m) Word8 -> Int -> Word8 -> m ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray (PrimState m) Word8
marr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Word8 -> m ()) -> Word8 -> m ()
forall a b. (a -> b) -> a -> b
$ Ptr Word8 -> Int -> Word8
forall a. Prim a => Ptr a -> Int -> a
indexOffPtr Ptr Word8
hexDigitTable (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
        | Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0  = do         -- for FiniteBits instances which has extra bits
            let !i :: Int
i = a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
v Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x0F :: Int
            MutablePrimArray (PrimState m) Word8 -> Int -> Word8 -> m ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray (PrimState m) Word8
marr Int
off (Word8 -> m ()) -> Word8 -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> Word8
forall a. Integral a => a -> Word8
i2wHex Int
i


-- | The UPPERCASED version of 'hex'.
hexUpper :: forall a. (FiniteBits a, Integral a) => a -> Builder ()
{-# INLINE hexUpper #-}
hexUpper :: a -> Builder ()
hexUpper a
w = Int
-> (MutablePrimArray RealWorld Word8 -> Int -> IO ()) -> Builder ()
writeN Int
hexSiz (a -> Int -> MutablePrimArray (PrimState IO) Word8 -> Int -> IO ()
forall a (m :: * -> *).
(Integral a, PrimMonad m, Bits a) =>
a -> Int -> MutablePrimArray (PrimState m) Word8 -> Int -> m ()
go a
w (Int
hexSizInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2))
  where
    bitSiz :: Int
bitSiz = a -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize (a
forall a. HasCallStack => a
undefined :: a)
    hexSiz :: Int
hexSiz = (Int
bitSizInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
3) Int -> Int -> Int
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = do
            let !i :: Int
i = a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
v Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xFF; !j :: Int
j = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i
            MutablePrimArray (PrimState m) Word8 -> Int -> Word8 -> m ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray (PrimState m) Word8
marr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
d) (Word8 -> m ()) -> Word8 -> m ()
forall a b. (a -> b) -> a -> b
$ Ptr Word8 -> Int -> Word8
forall a. Prim a => Ptr a -> Int -> a
indexOffPtr Ptr Word8
hexDigitTableUpper Int
j
            MutablePrimArray (PrimState m) Word8 -> Int -> Word8 -> m ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray (PrimState m) Word8
marr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Word8 -> m ()) -> Word8 -> m ()
forall a b. (a -> b) -> a -> b
$ Ptr Word8 -> Int -> Word8
forall a. Prim a => Ptr a -> Int -> a
indexOffPtr Ptr Word8
hexDigitTableUpper (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
            a -> Int -> MutablePrimArray (PrimState m) Word8 -> Int -> m ()
go (a
v a -> Int -> a
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
8) (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2) MutablePrimArray (PrimState m) Word8
marr Int
off
        | Int
d Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = do
            let !i :: Int
i = a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
v Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xFF; !j :: Int
j = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i
            MutablePrimArray (PrimState m) Word8 -> Int -> Word8 -> m ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray (PrimState m) Word8
marr Int
off (Word8 -> m ()) -> Word8 -> m ()
forall a b. (a -> b) -> a -> b
$ Ptr Word8 -> Int -> Word8
forall a. Prim a => Ptr a -> Int -> a
indexOffPtr Ptr Word8
hexDigitTableUpper Int
j
            MutablePrimArray (PrimState m) Word8 -> Int -> Word8 -> m ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray (PrimState m) Word8
marr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Word8 -> m ()) -> Word8 -> m ()
forall a b. (a -> b) -> a -> b
$ Ptr Word8 -> Int -> Word8
forall a. Prim a => Ptr a -> Int -> a
indexOffPtr Ptr Word8
hexDigitTableUpper (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
        | Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0  = do         -- for FiniteBits instances which has extra bits
            let !i :: Int
i = a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
v Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x0F :: Int
            MutablePrimArray (PrimState m) Word8 -> Int -> Word8 -> m ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray (PrimState m) Word8
marr Int
off (Word8 -> m ()) -> Word8 -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> Word8
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]
(FFormat -> FFormat)
-> (FFormat -> FFormat)
-> (Int -> FFormat)
-> (FFormat -> Int)
-> (FFormat -> [FFormat])
-> (FFormat -> FFormat -> [FFormat])
-> (FFormat -> FFormat -> [FFormat])
-> (FFormat -> FFormat -> FFormat -> [FFormat])
-> Enum 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]
(Int -> ReadS FFormat)
-> ReadS [FFormat]
-> ReadPrec FFormat
-> ReadPrec [FFormat]
-> Read 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
(Int -> FFormat -> ShowS)
-> (FFormat -> String) -> ([FFormat] -> ShowS) -> Show FFormat
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 Maybe Int
forall k1. Maybe k1
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 Maybe Int
forall k1. Maybe k1
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
    | Float -> Bool
forall a. RealFloat a => a -> Bool
isNaN Float
x                   = Builder ()
"NaN"
    | Float -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Float
x              = if Float
x Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
0 then Builder ()
"-Infinity" else Builder ()
"Infinity"
    | Float
x Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
0                     = Char -> Builder ()
char8 Char
'-' Builder () -> Builder () -> Builder ()
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))
    | Float -> Bool
forall a. RealFloat a => a -> Bool
isNegativeZero Float
x          = Char -> Builder ()
char8 Char
'-' Builder () -> Builder () -> Builder ()
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 Float -> Float -> Bool
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
    | Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
x                   = Builder ()
"NaN"
    | Double -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Double
x              = if Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0 then Builder ()
"-Infinity" else Builder ()
"Infinity"
    | Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0                     = Char -> Builder ()
char8 Char
'-' Builder () -> Builder () -> Builder ()
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))
    | Double -> Bool
forall a. RealFloat a => a -> Bool
isNegativeZero Double
x          = Char -> Builder ()
char8 Char
'-' Builder () -> Builder () -> Builder ()
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 Double -> Double -> Bool
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 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0
    then ([Int
0], Int
0)
    else case Integer
c of
#ifdef INTEGER_GMP
        (S# Int#
i#) -> Int -> Int -> [Int] -> ([Int], Int)
goI (Int# -> Int
I# Int#
i#) Int
0 []
#endif
        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 Int -> Int -> Int
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 #)
`quotRemInteger` Integer
10 of
                     (# Integer
q, Integer
r #) -> let !d :: Int
d = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
r in Integer -> Int -> [Int] -> ([Int], Int)
go Integer
q (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
dInt -> [Int] -> [Int]
forall k1. k1 -> [k1] -> [k1]
:[Int]
ds)
#ifdef INTEGER_GMP
    goI :: Int -> Int -> [Int] -> ([Int], Int)
    goI :: Int -> Int -> [Int] -> ([Int], Int)
goI Int
0 !Int
n [Int]
ds = let !ne :: Int
ne = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
e in ([Int]
ds, Int
ne)
    goI Int
i !Int
n [Int]
ds = case Int
i Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
10 of (Int
q, !Int
r) -> Int -> Int -> [Int] -> ([Int], Int)
goI Int
q (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
rInt -> [Int] -> [Int]
forall k1. k1 -> [k1] -> [k1]
:[Int]
ds)
#endif

-- | 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 -> FFormat -> Maybe Int -> ([Int], Int) -> Builder ()
doFmt (if Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
7 then FFormat
Exponent else FFormat
Fixed) Maybe Int
decs ([Int]
is,Int
e)
    FFormat
Exponent -> case Maybe Int
decs of
        Maybe Int
Nothing -> case [Int]
is of
            [Int
0]     -> Builder ()
"0.0e0"
            [Int
i]     -> Int -> Builder ()
encodeDigit Int
i Builder () -> Builder () -> Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Builder ()
".0e" Builder () -> Builder () -> Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Builder ()
forall a. (Integral a, Bounded a) => a -> Builder ()
int (Int
eInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
            (Int
i:[Int]
is') -> do
                Int -> Builder ()
encodeDigit Int
i
                Word8 -> Builder ()
forall a. Unaligned a => a -> Builder ()
encodePrim Word8
DOT
                [Int] -> Builder ()
encodeDigits [Int]
is'
                Word8 -> Builder ()
forall a. Unaligned a => a -> Builder ()
encodePrim Word8
LETTER_e
                Int -> Builder ()
forall a. (Integral a, Bounded a) => a -> Builder ()
int (Int
eInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
            []      -> String -> Builder ()
forall a. HasCallStack => String -> a
error String
"doFmt/Exponent: []"
        Just Int
dec
            | Int
dec Int -> Int -> Bool
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then [Int] -> [Int]
forall a. [a] -> [a]
List.init [Int]
is' else [Int]
is'
                        Int -> Builder ()
encodeDigit Int
n
                        Word8 -> Builder ()
forall a. Unaligned a => a -> Builder ()
encodePrim Word8
LETTER_e
                        Int -> Builder ()
forall a. (Integral a, Bounded a) => a -> Builder ()
int (Int
eInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
ei)
        Just Int
dec ->
            let !dec' :: Int
dec' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
dec Int
1 in
            case [Int]
is of
                [Int
0] -> do
                    Builder ()
"0." Builder () -> Builder () -> Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Builder ()
encodeZeros Int
dec' Builder () -> Builder () -> Builder ()
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'Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [Int]
is
                        (Int
d:[Int]
ds') = if Int
ei Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then [Int] -> [Int]
forall a. [a] -> [a]
List.init [Int]
is' else [Int]
is'
                    Int -> Builder ()
encodeDigit Int
d
                    Word8 -> Builder ()
forall a. Unaligned a => a -> Builder ()
encodePrim Word8
DOT
                    [Int] -> Builder ()
encodeDigits [Int]
ds'
                    Word8 -> Builder ()
forall a. Unaligned a => a -> Builder ()
encodePrim Word8
LETTER_e
                    Int -> Builder ()
forall a. (Integral a, Bounded a) => a -> Builder ()
int (Int
eInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
ei)
    FFormat
Fixed -> case Maybe Int
decs of
        Maybe Int
Nothing
            | Int
e Int -> Int -> Bool
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' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
dec Int
0
            in if Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
                then do
                    let (Int
ei,[Int]
is') = Int -> Int -> [Int] -> (Int, [Int])
roundTo Int
10 (Int
dec' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
e) [Int]
is
                        ([Int]
ls,[Int]
rs)  = Int -> [Int] -> ([Int], [Int])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int
eInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
ei) [Int]
is'
                    [Int] -> Builder ()
mk0 [Int]
ls
                    (Bool -> Builder () -> Builder ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
List.null [Int]
rs) (Builder () -> Builder ()) -> Builder () -> Builder ()
forall a b. (a -> b) -> a -> b
$ Word8 -> Builder ()
forall a. Unaligned a => a -> Builder ()
encodePrim Word8
DOT Builder () -> Builder () -> Builder ()
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' (Int -> Int -> [Int]
forall a. Int -> a -> [a]
List.replicate (-Int
e) Int
0 [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
is)
                        Int
d:[Int]
ds' = if Int
ei Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then [Int]
is' else Int
0Int -> [Int] -> [Int]
forall k1. k1 -> [k1] -> [k1]
:[Int]
is'
                    Int -> Builder ()
encodeDigit Int
d
                    (Bool -> Builder () -> Builder ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
List.null [Int]
ds') (Builder () -> Builder ()) -> Builder () -> Builder ()
forall a b. (a -> b) -> a -> b
$ Word8 -> Builder ()
forall a. Unaligned a => a -> Builder ()
encodePrim Word8
DOT Builder () -> Builder () -> Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Int] -> Builder ()
encodeDigits [Int]
ds')
  where
    encodeDigit :: Int -> Builder ()
encodeDigit = Word8 -> Builder ()
forall a. Unaligned a => a -> Builder ()
encodePrim (Word8 -> Builder ()) -> (Int -> Word8) -> Int -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word8
forall a. Integral a => a -> Word8
i2wDec

    encodeDigits :: [Int] -> Builder ()
encodeDigits = (Int -> Builder ()) -> [Int] -> Builder ()
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 -> Builder () -> Builder ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
n (Word8 -> Builder ()
forall a. Unaligned a => a -> Builder ()
encodePrim Word8
DIGIT_0)

    mk0 :: [Int] -> Builder ()
mk0 [] = Word8 -> Builder ()
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 = Word8 -> Builder ()
forall a. Unaligned a => a -> Builder ()
encodePrim Word8
DOT Builder () -> Builder () -> Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Int] -> Builder ()
mk0 [Int]
rs
    insertDot Int
n     [] = Word8 -> Builder ()
forall a. Unaligned a => a -> Builder ()
encodePrim Word8
DIGIT_0 Builder () -> Builder () -> Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> [Int] -> Builder ()
insertDot (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) []
    insertDot Int
n (Int
r:[Int]
rs) = Int -> Builder ()
encodeDigit Int
r Builder () -> Builder () -> Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> [Int] -> Builder ()
insertDot (Int
nInt -> Int -> Int
forall 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)
{-# INLINE grisu3 #-}
grisu3 :: Double -> ([Int], Int)
grisu3 Double
d = IO ([Int], Int) -> ([Int], Int)
forall a. IO a -> a
unsafePerformIO (IO ([Int], Int) -> ([Int], Int))
-> IO ([Int], Int) -> ([Int], Int)
forall a b. (a -> b) -> a -> b
$ do
    (MutableByteArray MutableByteArray# RealWorld
pBuf) <- Int -> IO (MutableByteArray (PrimState IO))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newByteArray GRISU3_DOUBLE_BUF_LEN
    (Int
len, (Int
e, Int
success)) <- (MutableByteArray# RealWorld -> IO (Int, Int))
-> IO (Int, (Int, Int))
forall a b.
Prim a =>
(MutableByteArray# RealWorld -> IO b) -> IO (a, b)
allocPrimUnsafe ((MutableByteArray# RealWorld -> IO (Int, Int))
 -> IO (Int, (Int, Int)))
-> (MutableByteArray# RealWorld -> IO (Int, Int))
-> IO (Int, (Int, Int))
forall a b. (a -> b) -> a -> b
$ \ MutableByteArray# RealWorld
pLen ->
        (MutableByteArray# RealWorld -> IO Int) -> IO (Int, Int)
forall a b.
Prim a =>
(MutableByteArray# RealWorld -> IO b) -> IO (a, b)
allocPrimUnsafe ((MutableByteArray# RealWorld -> IO Int) -> IO (Int, Int))
-> (MutableByteArray# RealWorld -> IO Int) -> IO (Int, Int)
forall a b. (a -> b) -> a -> b
$ \ MutableByteArray# RealWorld
pE ->
            Double
-> MutableByteArray# RealWorld
-> MutableByteArray# RealWorld
-> MutableByteArray# RealWorld
-> IO Int
c_grisu3 (Double -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
d) MutableByteArray# RealWorld
pBuf MutableByteArray# RealWorld
pLen MutableByteArray# RealWorld
pE
    if Int
success Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -- grisu3 fail
    then ([Int], Int) -> IO ([Int], Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Double -> ([Int], Int)
forall a. RealFloat a => Integer -> a -> ([Int], Int)
floatToDigits Integer
10 Double
d)
    else do
        [Int]
buf <- [Int] -> (Int -> IO Int) -> IO [Int]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Int
0..Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] ((Int -> IO Int) -> IO [Int]) -> (Int -> IO Int) -> IO [Int]
forall a b. (a -> b) -> a -> b
$ \ Int
i -> do
            Word8
w8 <- MutableByteArray (PrimState IO) -> Int -> IO Word8
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
readByteArray (MutableByteArray# RealWorld -> MutableByteArray RealWorld
forall s. MutableByteArray# s -> MutableByteArray s
MutableByteArray MutableByteArray# RealWorld
pBuf) Int
i :: IO Word8
            Int -> IO Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$! Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w8
        let !e' :: Int
e' = Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len
        ([Int], Int) -> IO ([Int], Int)
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)
{-# INLINE grisu3_sp #-}
grisu3_sp :: Float -> ([Int], Int)
grisu3_sp Float
d = IO ([Int], Int) -> ([Int], Int)
forall a. IO a -> a
unsafePerformIO (IO ([Int], Int) -> ([Int], Int))
-> IO ([Int], Int) -> ([Int], Int)
forall a b. (a -> b) -> a -> b
$ do
    (MutableByteArray MutableByteArray# RealWorld
pBuf) <- Int -> IO (MutableByteArray (PrimState IO))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newByteArray GRISU3_SINGLE_BUF_LEN
    (Int
len, (Int
e, Int
success)) <- (MutableByteArray# RealWorld -> IO (Int, Int))
-> IO (Int, (Int, Int))
forall a b.
Prim a =>
(MutableByteArray# RealWorld -> IO b) -> IO (a, b)
allocPrimUnsafe ((MutableByteArray# RealWorld -> IO (Int, Int))
 -> IO (Int, (Int, Int)))
-> (MutableByteArray# RealWorld -> IO (Int, Int))
-> IO (Int, (Int, Int))
forall a b. (a -> b) -> a -> b
$ \ MutableByteArray# RealWorld
pLen ->
        (MutableByteArray# RealWorld -> IO Int) -> IO (Int, Int)
forall a b.
Prim a =>
(MutableByteArray# RealWorld -> IO b) -> IO (a, b)
allocPrimUnsafe ((MutableByteArray# RealWorld -> IO Int) -> IO (Int, Int))
-> (MutableByteArray# RealWorld -> IO Int) -> IO (Int, Int)
forall a b. (a -> b) -> a -> b
$ \ MutableByteArray# RealWorld
pE ->
            Float
-> MutableByteArray# RealWorld
-> MutableByteArray# RealWorld
-> MutableByteArray# RealWorld
-> IO Int
c_grisu3_sp (Float -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
d) MutableByteArray# RealWorld
pBuf MutableByteArray# RealWorld
pLen MutableByteArray# RealWorld
pE
    if Int
success Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -- grisu3 fail
    then ([Int], Int) -> IO ([Int], Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Float -> ([Int], Int)
forall a. RealFloat a => Integer -> a -> ([Int], Int)
floatToDigits Integer
10 Float
d)
    else do
        [Int]
buf <- [Int] -> (Int -> IO Int) -> IO [Int]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Int
0..Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] ((Int -> IO Int) -> IO [Int]) -> (Int -> IO Int) -> IO [Int]
forall a b. (a -> b) -> a -> b
$ \ Int
i -> do
            Word8
w8 <- MutableByteArray (PrimState IO) -> Int -> IO Word8
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
readByteArray (MutableByteArray# RealWorld -> MutableByteArray RealWorld
forall s. MutableByteArray# s -> MutableByteArray s
MutableByteArray MutableByteArray# RealWorld
pBuf) Int
i :: IO Word8
            Int -> IO Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$! Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w8
        let !e' :: Int
e' = Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len
        ([Int], Int) -> IO ([Int], Int)
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 Maybe Int
forall k1. Maybe k1
Nothing

-- | 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 Scientific -> Scientific -> Bool
forall a. Ord a => a -> a -> Bool
< Scientific
0 = Char -> Builder ()
char8 Char
'-' Builder () -> Builder () -> Builder ()
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)