{-# LANGUAGE MagicHash, CPP, UnboxedTuples #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE LambdaCase #-}
module Mason.Builder
( Builder
, BuilderFor
, Buildable
, toStrictByteString
, toLazyByteString
, hPutBuilderLen
, hPutBuilder
, sendBuilder
, flush
, byteString
, lazyByteString
, shortByteString
, textUtf8
, encodeUtf8Builder
, encodeUtf8BuilderEscaped
, char7
, string7
, char8
, string8
, charUtf8
, stringUtf8
, storable
, int8
, word8
, int16LE
, int32LE
, int64LE
, word16LE
, word32LE
, word64LE
, floatLE
, doubleLE
, int16BE
, int32BE
, int64BE
, word16BE
, word32BE
, word64BE
, floatBE
, doubleBE
, floatDec
, doubleDec
, doubleSI
, doubleExp
, doubleFixed
, word8Dec
, word16Dec
, word32Dec
, word64Dec
, wordDec
, int8Dec
, int16Dec
, int32Dec
, int64Dec
, intDec
, integerDec
, word8Hex
, word16Hex
, word32Hex
, word64Hex
, wordHex
, int8HexFixed
, int16HexFixed
, int32HexFixed
, int64HexFixed
, word8HexFixed
, word16HexFixed
, word32HexFixed
, word64HexFixed
, floatHexFixed
, doubleHexFixed
, byteStringHex
, lazyByteStringHex
, intVLQ
, intVLQBP
, wordVLQ
, wordVLQBP
, prefixVarInt
, prefixVarIntBP
, paddedBoundedPrim
, zeroPaddedBoundedPrim
, primFixed
, primBounded
, lengthPrefixedWithin
) where
import Control.Monad
import qualified Data.Array as A
import Data.Bits
import Data.Word
import Data.Int
import qualified Data.Text as T
import Foreign.C.Types
import Foreign.Ptr (Ptr, plusPtr, castPtr)
import Foreign.Storable
import qualified Data.ByteString as B
import qualified Data.ByteString.Internal as B
import qualified Data.ByteString.Lazy as BL
import Mason.Builder.Internal as B
import qualified Data.ByteString.Builder.Prim as P
import qualified Data.ByteString.Builder.Prim.Internal as P
import GHC.Integer.GMP.Internals
import GHC.Types (Int(..))
import System.IO (Handle)
hPutBuilder :: Handle -> BuilderFor PutEnv -> IO ()
hPutBuilder :: Handle -> BuilderFor PutEnv -> IO ()
hPutBuilder h :: Handle
h b :: BuilderFor PutEnv
b = IO Int -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Int -> IO ()) -> IO Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Handle -> BuilderFor PutEnv -> IO Int
hPutBuilderLen Handle
h BuilderFor PutEnv
b
{-# INLINE hPutBuilder #-}
lazyByteString :: BL.ByteString -> Builder
lazyByteString :: ByteString -> Builder
lazyByteString = (ByteString -> BuilderFor s) -> [ByteString] -> BuilderFor s
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ByteString -> BuilderFor s
forall s. Buildable s => ByteString -> BuilderFor s
byteString ([ByteString] -> BuilderFor s)
-> (ByteString -> [ByteString]) -> ByteString -> BuilderFor s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
BL.toChunks
{-# INLINE lazyByteString #-}
{-# INLINE int8 #-}
int8 :: Int8 -> Builder
int8 :: Int8 -> Builder
int8 = FixedPrim Int8 -> Int8 -> Builder
forall a. FixedPrim a -> a -> Builder
B.primFixed FixedPrim Int8
P.int8
{-# INLINE word8 #-}
word8 :: Word8 -> Builder
word8 :: Word8 -> Builder
word8 = FixedPrim Word8 -> Word8 -> Builder
forall a. FixedPrim a -> a -> Builder
B.primFixed FixedPrim Word8
P.word8
{-# INLINE int16LE #-}
int16LE :: Int16 -> Builder
int16LE :: Int16 -> Builder
int16LE = FixedPrim Int16 -> Int16 -> Builder
forall a. FixedPrim a -> a -> Builder
B.primFixed FixedPrim Int16
P.int16LE
{-# INLINE int32LE #-}
int32LE :: Int32 -> Builder
int32LE :: Int32 -> Builder
int32LE = FixedPrim Int32 -> Int32 -> Builder
forall a. FixedPrim a -> a -> Builder
B.primFixed FixedPrim Int32
P.int32LE
{-# INLINE int64LE #-}
int64LE :: Int64 -> Builder
int64LE :: Int64 -> Builder
int64LE = FixedPrim Int64 -> Int64 -> Builder
forall a. FixedPrim a -> a -> Builder
B.primFixed FixedPrim Int64
P.int64LE
{-# INLINE word16LE #-}
word16LE :: Word16 -> Builder
word16LE :: Word16 -> Builder
word16LE = FixedPrim Word16 -> Word16 -> Builder
forall a. FixedPrim a -> a -> Builder
B.primFixed FixedPrim Word16
P.word16LE
{-# INLINE word32LE #-}
word32LE :: Word32 -> Builder
word32LE :: Word32 -> Builder
word32LE = FixedPrim Word32 -> Word32 -> Builder
forall a. FixedPrim a -> a -> Builder
B.primFixed FixedPrim Word32
P.word32LE
{-# INLINE word64LE #-}
word64LE :: Word64 -> Builder
word64LE :: Word64 -> Builder
word64LE = FixedPrim Word64 -> Word64 -> Builder
forall a. FixedPrim a -> a -> Builder
B.primFixed FixedPrim Word64
P.word64LE
{-# INLINE floatLE #-}
floatLE :: Float -> Builder
floatLE :: Float -> Builder
floatLE = FixedPrim Float -> Float -> Builder
forall a. FixedPrim a -> a -> Builder
B.primFixed FixedPrim Float
P.floatLE
{-# INLINE doubleLE #-}
doubleLE :: Double -> Builder
doubleLE :: Double -> Builder
doubleLE = FixedPrim Double -> Double -> Builder
forall a. FixedPrim a -> a -> Builder
B.primFixed FixedPrim Double
P.doubleLE
{-# INLINE int16BE #-}
int16BE :: Int16 -> Builder
int16BE :: Int16 -> Builder
int16BE = FixedPrim Int16 -> Int16 -> Builder
forall a. FixedPrim a -> a -> Builder
B.primFixed FixedPrim Int16
P.int16BE
{-# INLINE int32BE #-}
int32BE :: Int32 -> Builder
int32BE :: Int32 -> Builder
int32BE = FixedPrim Int32 -> Int32 -> Builder
forall a. FixedPrim a -> a -> Builder
B.primFixed FixedPrim Int32
P.int32BE
{-# INLINE int64BE #-}
int64BE :: Int64 -> Builder
int64BE :: Int64 -> Builder
int64BE = FixedPrim Int64 -> Int64 -> Builder
forall a. FixedPrim a -> a -> Builder
B.primFixed FixedPrim Int64
P.int64BE
{-# INLINE word16BE #-}
word16BE :: Word16 -> Builder
word16BE :: Word16 -> Builder
word16BE = FixedPrim Word16 -> Word16 -> Builder
forall a. FixedPrim a -> a -> Builder
B.primFixed FixedPrim Word16
P.word16BE
{-# INLINE word32BE #-}
word32BE :: Word32 -> Builder
word32BE :: Word32 -> Builder
word32BE = FixedPrim Word32 -> Word32 -> Builder
forall a. FixedPrim a -> a -> Builder
B.primFixed FixedPrim Word32
P.word32BE
{-# INLINE word64BE #-}
word64BE :: Word64 -> Builder
word64BE :: Word64 -> Builder
word64BE = FixedPrim Word64 -> Word64 -> Builder
forall a. FixedPrim a -> a -> Builder
B.primFixed FixedPrim Word64
P.word64BE
{-# INLINE floatBE #-}
floatBE :: Float -> Builder
floatBE :: Float -> Builder
floatBE = FixedPrim Float -> Float -> Builder
forall a. FixedPrim a -> a -> Builder
B.primFixed FixedPrim Float
P.floatBE
{-# INLINE doubleBE #-}
doubleBE :: Double -> Builder
doubleBE :: Double -> Builder
doubleBE = FixedPrim Double -> Double -> Builder
forall a. FixedPrim a -> a -> Builder
B.primFixed FixedPrim Double
P.doubleBE
{-# INLINE char7 #-}
char7 :: Char -> Builder
char7 :: Char -> Builder
char7 = FixedPrim Char -> Char -> Builder
forall a. FixedPrim a -> a -> Builder
B.primFixed FixedPrim Char
P.char7
{-# INLINE string7 #-}
string7 :: String -> Builder
string7 :: String -> Builder
string7 = FixedPrim Char -> String -> Builder
forall a. FixedPrim a -> [a] -> Builder
B.primMapListFixed FixedPrim Char
P.char7
{-# INLINE char8 #-}
char8 :: Char -> Builder
char8 :: Char -> Builder
char8 = FixedPrim Char -> Char -> Builder
forall a. FixedPrim a -> a -> Builder
B.primFixed FixedPrim Char
P.char8
{-# INLINE string8 #-}
string8 :: String -> Builder
string8 :: String -> Builder
string8 = FixedPrim Char -> String -> Builder
forall a. FixedPrim a -> [a] -> Builder
B.primMapListFixed FixedPrim Char
P.char8
{-# INLINE charUtf8 #-}
charUtf8 :: Char -> Builder
charUtf8 :: Char -> Builder
charUtf8 = BoundedPrim Char -> Char -> Builder
forall a. BoundedPrim a -> a -> Builder
B.primBounded BoundedPrim Char
P.charUtf8
encodeUtf8Builder :: T.Text -> Builder
encodeUtf8Builder :: Text -> Builder
encodeUtf8Builder = Text -> BuilderFor s
Text -> Builder
textUtf8
{-# INLINE encodeUtf8Builder #-}
textUtf8 :: T.Text -> Builder
textUtf8 :: Text -> Builder
textUtf8 = BoundedPrim Word8 -> Text -> Builder
B.encodeUtf8BuilderEscaped (FixedPrim Word8 -> BoundedPrim Word8
forall a. FixedPrim a -> BoundedPrim a
P.liftFixedToBounded FixedPrim Word8
P.word8)
{-# INLINE textUtf8 #-}
{-# INLINE word8Dec #-}
word8Dec :: Word8 -> Builder
word8Dec :: Word8 -> Builder
word8Dec = BoundedPrim Word8 -> Word8 -> Builder
forall a. BoundedPrim a -> a -> Builder
B.primBounded BoundedPrim Word8
P.word8Dec
{-# INLINE word16Dec #-}
word16Dec :: Word16 -> Builder
word16Dec :: Word16 -> Builder
word16Dec = BoundedPrim Word16 -> Word16 -> Builder
forall a. BoundedPrim a -> a -> Builder
B.primBounded BoundedPrim Word16
P.word16Dec
{-# INLINE word32Dec #-}
word32Dec :: Word32 -> Builder
word32Dec :: Word32 -> Builder
word32Dec = BoundedPrim Word32 -> Word32 -> Builder
forall a. BoundedPrim a -> a -> Builder
B.primBounded BoundedPrim Word32
P.word32Dec
{-# INLINE word64Dec #-}
word64Dec :: Word64 -> Builder
word64Dec :: Word64 -> Builder
word64Dec = BoundedPrim Word64 -> Word64 -> Builder
forall a. BoundedPrim a -> a -> Builder
B.primBounded BoundedPrim Word64
P.word64Dec
{-# INLINE wordDec #-}
wordDec :: Word -> Builder
wordDec :: Word -> Builder
wordDec = BoundedPrim Word -> Word -> Builder
forall a. BoundedPrim a -> a -> Builder
B.primBounded BoundedPrim Word
P.wordDec
{-# INLINE floatDec #-}
floatDec :: Float -> Builder
floatDec :: Float -> Builder
floatDec = String -> BuilderFor s
String -> Builder
string7 (String -> BuilderFor s)
-> (Float -> String) -> Float -> BuilderFor s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> String
forall a. Show a => a -> String
show
wrapDoubleDec :: (Double -> Builder) -> Double -> Builder
wrapDoubleDec :: (Double -> Builder) -> Double -> Builder
wrapDoubleDec k :: Double -> Builder
k x :: Double
x
| Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
x = String -> Builder
string7 "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
< 0 then String -> Builder
string7 "-Infinity" else String -> Builder
string7 "Infinity"
| Double -> Bool
forall a. RealFloat a => a -> Bool
isNegativeZero Double
x = Char -> Builder
char7 '-' BuilderFor s -> BuilderFor s -> BuilderFor s
forall a. Semigroup a => a -> a -> a
<> Double -> Builder
k 0.0
| Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = Char -> Builder
char7 '-' BuilderFor s -> BuilderFor s -> BuilderFor s
forall a. Semigroup a => a -> a -> a
<> Double -> Builder
k (-Double
x)
| Bool
otherwise = Double -> Builder
k Double
x
{-# INLINE wrapDoubleDec #-}
{-# INLINE doubleDec #-}
doubleDec :: Double -> Builder
doubleDec :: Double -> Builder
doubleDec = (Double -> Builder) -> Double -> BuilderFor s
(Double -> Builder) -> Double -> Builder
wrapDoubleDec ((Double -> Builder) -> Double -> BuilderFor s)
-> (Double -> Builder) -> Double -> BuilderFor s
forall a b. (a -> b) -> a -> b
$ \case
0 -> String -> Builder
string7 "0.0"
x :: Double
x -> Double -> BuilderFor s
forall s. Buildable s => Double -> BuilderFor s
grisu Double
x
where
grisu :: Double -> BuilderFor s
grisu v :: Double
v = Int -> (Ptr Word8 -> IO (Ptr Word8)) -> BuilderFor s
forall s.
Buildable s =>
Int -> (Ptr Word8 -> IO (Ptr Word8)) -> BuilderFor s
withPtr 24 ((Ptr Word8 -> IO (Ptr Word8)) -> BuilderFor s)
-> (Ptr Word8 -> IO (Ptr Word8)) -> BuilderFor s
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Word8
ptr -> do
CInt
n <- Double -> Ptr Word8 -> IO CInt
dtoa_grisu3 Double
v Ptr Word8
ptr
Ptr Word8 -> IO (Ptr Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Word8 -> IO (Ptr Word8)) -> Ptr Word8 -> IO (Ptr Word8)
forall a b. (a -> b) -> a -> b
$ Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
ptr (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
n)
foreign import ccall unsafe "static dtoa_grisu3"
dtoa_grisu3 :: Double -> Ptr Word8 -> IO CInt
doubleSI :: Int
-> Double
-> Builder
doubleSI :: Int -> Double -> Builder
doubleSI prec :: Int
prec | Int
prec Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 3 = String -> Double -> BuilderFor s
forall a. HasCallStack => String -> a
error "Mason.Builder.doubleSI: precision less than 3"
doubleSI prec :: Int
prec = (Double -> Builder) -> Double -> BuilderFor s
(Double -> Builder) -> Double -> Builder
wrapDoubleDec ((Double -> Builder) -> Double -> BuilderFor s)
-> (Double -> Builder) -> Double -> BuilderFor s
forall a b. (a -> b) -> a -> b
$ \case
0 -> Int -> Builder
zeroes Int
prec
val :: Double
val -> (s -> Buffer -> IO Buffer) -> BuilderFor s
forall s. (s -> Buffer -> IO Buffer) -> BuilderFor s
Builder ((s -> Buffer -> IO Buffer) -> BuilderFor s)
-> (s -> Buffer -> IO Buffer) -> BuilderFor s
forall a b. (a -> b) -> a -> b
$ \env :: s
env buf :: Buffer
buf -> Int
-> Double -> (Ptr Word8 -> Int -> Int -> IO Buffer) -> IO Buffer
forall r.
Int -> Double -> (Ptr Word8 -> Int -> Int -> IO r) -> IO r
withGrisu3Rounded Int
prec Double
val ((Ptr Word8 -> Int -> Int -> IO Buffer) -> IO Buffer)
-> (Ptr Word8 -> Int -> Int -> IO Buffer) -> IO Buffer
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Word8
ptr len :: Int
len e :: Int
e -> do
let (pindex :: Int
pindex, dp :: Int
dp) = Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
divMod (Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) 3
(Int, Int, Int) -> IO ()
forall a. Show a => a -> IO ()
print (Int
dp, Int
prec, Int
len)
let mantissa :: BuilderFor s
mantissa
| Int
dp Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
prec = Int -> (Ptr Word8 -> IO (Ptr Word8)) -> BuilderFor s
forall s.
Buildable s =>
Int -> (Ptr Word8 -> IO (Ptr Word8)) -> BuilderFor s
withPtr (Int
prec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dp Int -> Int -> Int
forall a. Num a => a -> a -> a
- 2) ((Ptr Word8 -> IO (Ptr Word8)) -> BuilderFor s)
-> (Ptr Word8 -> IO (Ptr Word8)) -> BuilderFor s
forall a b. (a -> b) -> a -> b
$ \dst :: Ptr Word8
dst -> do
Ptr Word8
_ <- Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8)
B.memset Ptr Word8
dst 48 (CSize -> IO (Ptr Word8)) -> CSize -> IO (Ptr Word8)
forall a b. (a -> b) -> a -> b
$ Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
prec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dp Int -> Int -> Int
forall a. Num a => a -> a -> a
- 2)
Ptr Word8 -> Ptr Word8 -> Int -> IO ()
B.memcpy Ptr Word8
dst Ptr Word8
ptr (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
len Int
prec
Ptr Word8 -> IO (Ptr Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Word8 -> IO (Ptr Word8)) -> Ptr Word8 -> IO (Ptr Word8)
forall a b. (a -> b) -> a -> b
$ Ptr Word8
dst Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
prec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dp Int -> Int -> Int
forall a. Num a => a -> a -> a
- 2)
| Bool
otherwise = Int -> (Ptr Word8 -> IO (Ptr Word8)) -> BuilderFor s
forall s.
Buildable s =>
Int -> (Ptr Word8 -> IO (Ptr Word8)) -> BuilderFor s
withPtr (Int
prec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) ((Ptr Word8 -> IO (Ptr Word8)) -> BuilderFor s)
-> (Ptr Word8 -> IO (Ptr Word8)) -> BuilderFor s
forall a b. (a -> b) -> a -> b
$ \dst :: Ptr Word8
dst -> do
Ptr Word8
_ <- Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8)
B.memset Ptr Word8
dst 48 (CSize -> IO (Ptr Word8)) -> CSize -> IO (Ptr Word8)
forall a b. (a -> b) -> a -> b
$ Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
prec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)
Ptr Word8 -> Ptr Word8 -> Int -> IO ()
B.memcpy Ptr Word8
dst Ptr Word8
ptr (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
len (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
dp Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1
Ptr Word8 -> Int -> Word8 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word8
dst (Int
dp Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) 46
Ptr Word8 -> Ptr Word8 -> Int -> IO ()
B.memcpy (Ptr Word8
dst Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
dp Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2)) (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
dp Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)) (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
dp Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1
Ptr Word8 -> IO (Ptr Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Word8 -> IO (Ptr Word8)) -> Ptr Word8 -> IO (Ptr Word8)
forall a b. (a -> b) -> a -> b
$ Ptr Word8
dst Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
prec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)
let prefix :: BuilderFor s
prefix
| Int
pindex Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = BuilderFor s
forall a. Monoid a => a
mempty
| Int
pindex Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 8 Bool -> Bool -> Bool
|| Int
pindex Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< (-8) = Char -> Builder
char7 'e' BuilderFor s -> BuilderFor s -> BuilderFor s
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intDec (3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
pindex)
| Bool
otherwise = Char -> Builder
charUtf8 (Array Int Char
prefices Array Int Char -> Int -> Char
forall i e. Ix i => Array i e -> i -> e
A.! Int
pindex)
BuilderFor s -> s -> Buffer -> IO Buffer
forall s. BuilderFor s -> s -> Buffer -> IO Buffer
unBuilder (BuilderFor s
mantissa BuilderFor s -> BuilderFor s -> BuilderFor s
forall a. Semigroup a => a -> a -> a
<> BuilderFor s
prefix) s
env Buffer
buf
where
prefices :: Array Int Char
prefices = (Int, Int) -> String -> Array Int Char
forall i e. Ix i => (i, i) -> [e] -> Array i e
A.listArray (-8,8) "yzafpnμm\NULkMGTPEZY"
zeroes :: Int -> Builder
zeroes :: Int -> Builder
zeroes n :: Int
n = Int -> (Ptr Word8 -> IO (Ptr Word8)) -> BuilderFor s
forall s.
Buildable s =>
Int -> (Ptr Word8 -> IO (Ptr Word8)) -> BuilderFor s
withPtr (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) ((Ptr Word8 -> IO (Ptr Word8)) -> BuilderFor s)
-> (Ptr Word8 -> IO (Ptr Word8)) -> BuilderFor s
forall a b. (a -> b) -> a -> b
$ \dst :: Ptr Word8
dst -> do
Ptr Word8
_ <- Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8)
B.memset Ptr Word8
dst 48 (CSize -> IO (Ptr Word8)) -> CSize -> IO (Ptr Word8)
forall a b. (a -> b) -> a -> b
$ Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CSize) -> Int -> CSize
forall a b. (a -> b) -> a -> b
$ Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1
Ptr Word8 -> Int -> Word8 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word8
dst 1 46
Ptr Word8 -> IO (Ptr Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Word8 -> IO (Ptr Word8)) -> Ptr Word8 -> IO (Ptr Word8)
forall a b. (a -> b) -> a -> b
$ Ptr Word8
dst Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)
doubleExp :: Int
-> Double
-> Builder
doubleExp :: Int -> Double -> Builder
doubleExp prec :: Int
prec | Int
prec Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 1 = String -> Double -> BuilderFor s
forall a. HasCallStack => String -> a
error "Mason.Builder.doubleFixed: precision too small"
doubleExp prec :: Int
prec = (Double -> Builder) -> Double -> BuilderFor s
(Double -> Builder) -> Double -> Builder
wrapDoubleDec ((Double -> Builder) -> Double -> BuilderFor s)
-> (Double -> Builder) -> Double -> BuilderFor s
forall a b. (a -> b) -> a -> b
$ \case
0 -> Int -> Builder
zeroes Int
prec BuilderFor s -> BuilderFor s -> BuilderFor s
forall a. Semigroup a => a -> a -> a
<> String -> Builder
string7 "e0"
val :: Double
val -> (s -> Buffer -> IO Buffer) -> BuilderFor s
forall s. (s -> Buffer -> IO Buffer) -> BuilderFor s
Builder ((s -> Buffer -> IO Buffer) -> BuilderFor s)
-> (s -> Buffer -> IO Buffer) -> BuilderFor s
forall a b. (a -> b) -> a -> b
$ \env :: s
env buf :: Buffer
buf -> Int
-> Double -> (Ptr Word8 -> Int -> Int -> IO Buffer) -> IO Buffer
forall r.
Int -> Double -> (Ptr Word8 -> Int -> Int -> IO r) -> IO r
withGrisu3Rounded Int
prec Double
val ((Ptr Word8 -> Int -> Int -> IO Buffer) -> IO Buffer)
-> (Ptr Word8 -> Int -> Int -> IO Buffer) -> IO Buffer
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Word8
ptr len :: Int
len dp :: Int
dp -> do
let len' :: Int
len' = 1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
prec
Word8
firstDigit <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
ptr
BuilderFor s -> s -> Buffer -> IO Buffer
forall s. BuilderFor s -> s -> Buffer -> IO Buffer
unBuilder (Int -> (Ptr Word8 -> IO (Ptr Word8)) -> BuilderFor s
forall s.
Buildable s =>
Int -> (Ptr Word8 -> IO (Ptr Word8)) -> BuilderFor s
withPtr Int
len' (\dst :: Ptr Word8
dst -> do
Ptr Word8
_ <- Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8)
B.memset Ptr Word8
dst 48 (CSize -> IO (Ptr Word8)) -> CSize -> IO (Ptr Word8)
forall a b. (a -> b) -> a -> b
$ Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len'
Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
dst Word8
firstDigit
Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
dst Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 1) (46 :: Word8)
Ptr Word8 -> Ptr Word8 -> Int -> IO ()
B.memcpy (Ptr Word8
dst Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 2) (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 1) (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) Int
len')
Ptr Word8 -> IO (Ptr Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Word8
dst Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
len'))
BuilderFor s -> BuilderFor s -> BuilderFor s
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 'e' BuilderFor s -> BuilderFor s -> BuilderFor s
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intDec (Int
dp Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1)) s
env Buffer
buf
doubleFixed :: Int
-> Double
-> Builder
doubleFixed :: Int -> Double -> Builder
doubleFixed 0 = Int -> BuilderFor s
Int -> Builder
intDec (Int -> BuilderFor s) -> (Double -> Int) -> Double -> BuilderFor s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round
doubleFixed prec :: Int
prec | Int
prec Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = String -> Double -> BuilderFor s
forall a. HasCallStack => String -> a
error "Mason.Builder.doubleFixed: negative precision"
doubleFixed prec :: Int
prec = (Double -> Builder) -> Double -> BuilderFor s
(Double -> Builder) -> Double -> Builder
wrapDoubleDec ((Double -> Builder) -> Double -> BuilderFor s)
-> (Double -> Builder) -> Double -> BuilderFor s
forall a b. (a -> b) -> a -> b
$ \case
0 -> Int -> Builder
zeroes (Int
prec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)
val :: Double
val -> (s -> Buffer -> IO Buffer) -> BuilderFor s
forall s. (s -> Buffer -> IO Buffer) -> BuilderFor s
Builder ((s -> Buffer -> IO Buffer) -> BuilderFor s)
-> (s -> Buffer -> IO Buffer) -> BuilderFor s
forall a b. (a -> b) -> a -> b
$ \env :: s
env buf :: Buffer
buf -> Double
-> IO Buffer -> (Ptr Word8 -> Int -> Int -> IO Buffer) -> IO Buffer
forall r.
Double -> IO r -> (Ptr Word8 -> Int -> Int -> IO r) -> IO r
withGrisu3 Double
val (BuilderFor s -> s -> Buffer -> IO Buffer
forall s. BuilderFor s -> s -> Buffer -> IO Buffer
unBuilder (Double -> Builder
doubleDec Double
val) s
env Buffer
buf) ((Ptr Word8 -> Int -> Int -> IO Buffer) -> IO Buffer)
-> (Ptr Word8 -> Int -> Int -> IO Buffer) -> IO Buffer
forall a b. (a -> b) -> a -> b
$ \ptr0 :: Ptr Word8
ptr0 len :: Int
len e0 :: Int
e0 -> do
Bool
bump <- Int -> Int -> Ptr Word8 -> IO Bool
roundDigit (Int
prec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
e0) Int
len Ptr Word8
ptr0
let dp :: Int
dp
| Bool
bump = Int
e0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1
| Bool
otherwise = Int
e0
let ptr :: Ptr Word8
ptr
| Bool
bump = Ptr Word8
ptr0
| Bool
otherwise = Ptr Word8
ptr0 Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 1
let len' :: Int
len' = 1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
prec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 1 Int
dp
BuilderFor s -> s -> Buffer -> IO Buffer
forall s. BuilderFor s -> s -> Buffer -> IO Buffer
unBuilder (Int -> (Ptr Word8 -> IO (Ptr Word8)) -> BuilderFor s
forall s.
Buildable s =>
Int -> (Ptr Word8 -> IO (Ptr Word8)) -> BuilderFor s
withPtr Int
len' ((Ptr Word8 -> IO (Ptr Word8)) -> BuilderFor s)
-> (Ptr Word8 -> IO (Ptr Word8)) -> BuilderFor s
forall a b. (a -> b) -> a -> b
$ \dst :: Ptr Word8
dst -> do
Ptr Word8
_ <- Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8)
B.memset Ptr Word8
dst 48 (CSize -> IO (Ptr Word8)) -> CSize -> IO (Ptr Word8)
forall a b. (a -> b) -> a -> b
$ Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len'
if Int
dp Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 1
then do
Ptr Word8 -> Ptr Word8 -> Int -> IO ()
B.memcpy Ptr Word8
dst Ptr Word8
ptr (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
len Int
dp
Ptr Word8 -> Int -> Word8 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word8
dst Int
dp 46
Ptr Word8 -> Ptr Word8 -> Int -> IO ()
B.memcpy (Ptr Word8
dst Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
dp Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)) (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
dp) (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 0 (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
dp)
else do
Ptr Word8 -> Int -> Word8 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word8
dst 1 46
Ptr Word8 -> Ptr Word8 -> Int -> IO ()
B.memcpy (Ptr Word8
dst Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
dp)) Ptr Word8
ptr Int
len
Ptr Word8 -> IO (Ptr Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Word8 -> IO (Ptr Word8)) -> Ptr Word8 -> IO (Ptr Word8)
forall a b. (a -> b) -> a -> b
$ Ptr Word8
dst Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
len'
) s
env Buffer
buf
{-# INLINE int8Dec #-}
int8Dec :: Int8 -> Builder
int8Dec :: Int8 -> Builder
int8Dec = BoundedPrim Int8 -> Int8 -> Builder
forall a. BoundedPrim a -> a -> Builder
B.primBounded BoundedPrim Int8
P.int8Dec
{-# INLINE int16Dec #-}
int16Dec :: Int16 -> Builder
int16Dec :: Int16 -> Builder
int16Dec = BoundedPrim Int16 -> Int16 -> Builder
forall a. BoundedPrim a -> a -> Builder
B.primBounded BoundedPrim Int16
P.int16Dec
{-# INLINE int32Dec #-}
int32Dec :: Int32 -> Builder
int32Dec :: Int32 -> Builder
int32Dec = BoundedPrim Int32 -> Int32 -> Builder
forall a. BoundedPrim a -> a -> Builder
B.primBounded BoundedPrim Int32
P.int32Dec
{-# INLINE int64Dec #-}
int64Dec :: Int64 -> Builder
int64Dec :: Int64 -> Builder
int64Dec = BoundedPrim Int64 -> Int64 -> Builder
forall a. BoundedPrim a -> a -> Builder
B.primBounded BoundedPrim Int64
P.int64Dec
{-# INLINE intDec #-}
intDec :: Int -> Builder
intDec :: Int -> Builder
intDec = BoundedPrim Int -> Int -> Builder
forall a. BoundedPrim a -> a -> Builder
B.primBounded BoundedPrim Int
P.intDec
{-# INLINE word8Hex #-}
word8Hex :: Word8 -> Builder
word8Hex :: Word8 -> Builder
word8Hex = BoundedPrim Word8 -> Word8 -> Builder
forall a. BoundedPrim a -> a -> Builder
B.primBounded BoundedPrim Word8
P.word8Hex
{-# INLINE word16Hex #-}
word16Hex :: Word16 -> Builder
word16Hex :: Word16 -> Builder
word16Hex = BoundedPrim Word16 -> Word16 -> Builder
forall a. BoundedPrim a -> a -> Builder
B.primBounded BoundedPrim Word16
P.word16Hex
{-# INLINE word32Hex #-}
word32Hex :: Word32 -> Builder
word32Hex :: Word32 -> Builder
word32Hex = BoundedPrim Word32 -> Word32 -> Builder
forall a. BoundedPrim a -> a -> Builder
B.primBounded BoundedPrim Word32
P.word32Hex
{-# INLINE word64Hex #-}
word64Hex :: Word64 -> Builder
word64Hex :: Word64 -> Builder
word64Hex = BoundedPrim Word64 -> Word64 -> Builder
forall a. BoundedPrim a -> a -> Builder
B.primBounded BoundedPrim Word64
P.word64Hex
{-# INLINE wordHex #-}
wordHex :: Word -> Builder
wordHex :: Word -> Builder
wordHex = BoundedPrim Word -> Word -> Builder
forall a. BoundedPrim a -> a -> Builder
B.primBounded BoundedPrim Word
P.wordHex
{-# INLINE int8HexFixed #-}
int8HexFixed :: Int8 -> Builder
int8HexFixed :: Int8 -> Builder
int8HexFixed = FixedPrim Int8 -> Int8 -> Builder
forall a. FixedPrim a -> a -> Builder
B.primFixed FixedPrim Int8
P.int8HexFixed
{-# INLINE int16HexFixed #-}
int16HexFixed :: Int16 -> Builder
int16HexFixed :: Int16 -> Builder
int16HexFixed = FixedPrim Int16 -> Int16 -> Builder
forall a. FixedPrim a -> a -> Builder
B.primFixed FixedPrim Int16
P.int16HexFixed
{-# INLINE int32HexFixed #-}
int32HexFixed :: Int32 -> Builder
int32HexFixed :: Int32 -> Builder
int32HexFixed = FixedPrim Int32 -> Int32 -> Builder
forall a. FixedPrim a -> a -> Builder
B.primFixed FixedPrim Int32
P.int32HexFixed
{-# INLINE int64HexFixed #-}
int64HexFixed :: Int64 -> Builder
int64HexFixed :: Int64 -> Builder
int64HexFixed = FixedPrim Int64 -> Int64 -> Builder
forall a. FixedPrim a -> a -> Builder
B.primFixed FixedPrim Int64
P.int64HexFixed
{-# INLINE word8HexFixed #-}
word8HexFixed :: Word8 -> Builder
word8HexFixed :: Word8 -> Builder
word8HexFixed = FixedPrim Word8 -> Word8 -> Builder
forall a. FixedPrim a -> a -> Builder
B.primFixed FixedPrim Word8
P.word8HexFixed
{-# INLINE word16HexFixed #-}
word16HexFixed :: Word16 -> Builder
word16HexFixed :: Word16 -> Builder
word16HexFixed = FixedPrim Word16 -> Word16 -> Builder
forall a. FixedPrim a -> a -> Builder
B.primFixed FixedPrim Word16
P.word16HexFixed
{-# INLINE word32HexFixed #-}
word32HexFixed :: Word32 -> Builder
word32HexFixed :: Word32 -> Builder
word32HexFixed = FixedPrim Word32 -> Word32 -> Builder
forall a. FixedPrim a -> a -> Builder
B.primFixed FixedPrim Word32
P.word32HexFixed
{-# INLINE word64HexFixed #-}
word64HexFixed :: Word64 -> Builder
word64HexFixed :: Word64 -> Builder
word64HexFixed = FixedPrim Word64 -> Word64 -> Builder
forall a. FixedPrim a -> a -> Builder
B.primFixed FixedPrim Word64
P.word64HexFixed
{-# INLINE floatHexFixed #-}
floatHexFixed :: Float -> Builder
floatHexFixed :: Float -> Builder
floatHexFixed = FixedPrim Float -> Float -> Builder
forall a. FixedPrim a -> a -> Builder
B.primFixed FixedPrim Float
P.floatHexFixed
{-# INLINE doubleHexFixed #-}
doubleHexFixed :: Double -> Builder
doubleHexFixed :: Double -> Builder
doubleHexFixed = FixedPrim Double -> Double -> Builder
forall a. FixedPrim a -> a -> Builder
B.primFixed FixedPrim Double
P.doubleHexFixed
{-# NOINLINE byteStringHex #-}
byteStringHex :: B.ByteString -> Builder
byteStringHex :: ByteString -> Builder
byteStringHex = FixedPrim Word8 -> ByteString -> Builder
B.primMapByteStringFixed FixedPrim Word8
P.word8HexFixed
{-# NOINLINE lazyByteStringHex #-}
lazyByteStringHex :: BL.ByteString -> Builder
lazyByteStringHex :: ByteString -> Builder
lazyByteStringHex = FixedPrim Word8 -> ByteString -> Builder
B.primMapLazyByteStringFixed FixedPrim Word8
P.word8HexFixed
#define PAIR(a,b) (# a,b #)
{-# INLINE caseWordSize_32_64 #-}
caseWordSize_32_64 :: a
-> a
-> a
caseWordSize_32_64 :: a -> a -> a
caseWordSize_32_64 f32 :: a
f32 f64 :: a
f64 =
#if MIN_VERSION_base(4,7,0)
case Word -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize (Word
forall a. HasCallStack => a
undefined :: Word) of
#else
case bitSize (undefined :: Word) of
#endif
32 -> a
f32
64 -> a
f64
s :: Int
s -> String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ "caseWordSize_32_64: unsupported Word bit-size " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
s
maxPow10 :: Integer
maxPow10 :: Integer
maxPow10 = Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ (10 :: Int) Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^ Int -> Int -> Int
forall a. a -> a -> a
caseWordSize_32_64 (9 :: Int) 18
integerDec :: Integer -> Builder
integerDec :: Integer -> Builder
integerDec (S# i# :: Int#
i#) = Int -> Builder
intDec (Int# -> Int
I# Int#
i#)
integerDec i :: Integer
i
| Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = FixedPrim Char -> Char -> Builder
forall a. FixedPrim a -> a -> Builder
B.primFixed FixedPrim Char
P.char8 '-' BuilderFor s -> BuilderFor s -> BuilderFor s
forall a. Monoid a => a -> a -> a
`mappend` Integer -> Builder
go (-Integer
i)
| Bool
otherwise = Integer -> Builder
go ( Integer
i)
where
errImpossible :: String -> a
errImpossible fun :: String
fun =
String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ "integerDec: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fun String -> String -> String
forall a. [a] -> [a] -> [a]
++ ": the impossible happened."
go :: Integer -> Builder
go :: Integer -> Builder
go n :: Integer
n | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
maxPow10 = Int -> Builder
intDec (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n)
| Bool
otherwise =
case [Integer] -> [Int]
putH (Integer -> Integer -> [Integer]
splitf (Integer
maxPow10 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
maxPow10) Integer
n) of
(x :: Int
x:xs :: [Int]
xs) -> Int -> Builder
intDec Int
x BuilderFor s -> BuilderFor s -> BuilderFor s
forall a. Monoid a => a -> a -> a
`mappend` BoundedPrim Int -> [Int] -> Builder
forall a. BoundedPrim a -> [a] -> Builder
B.primMapListBounded BoundedPrim Int
intDecPadded [Int]
xs
[] -> String -> BuilderFor s
forall a. String -> a
errImpossible "integerDec: go"
splitf :: Integer -> Integer -> [Integer]
splitf :: Integer -> Integer -> [Integer]
splitf pow10 :: Integer
pow10 n0 :: Integer
n0
| Integer
pow10 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
n0 = [Integer
n0]
| Bool
otherwise = [Integer] -> [Integer]
splith (Integer -> Integer -> [Integer]
splitf (Integer
pow10 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
pow10) Integer
n0)
where
splith :: [Integer] -> [Integer]
splith [] = String -> [Integer]
forall a. String -> a
errImpossible "splith"
splith (n :: Integer
n:ns :: [Integer]
ns) =
case Integer
n Integer -> Integer -> (# Integer, Integer #)
`quotRemInteger` Integer
pow10 of
PAIR(r :: Integer
q,r) | Integer
q Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> 0 -> Integer
q Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: Integer
r Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: [Integer] -> [Integer]
splitb [Integer]
ns
| Bool
otherwise -> Integer
r Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: [Integer] -> [Integer]
splitb [Integer]
ns
splitb :: [Integer] -> [Integer]
splitb [] = []
splitb (n :: Integer
n:ns :: [Integer]
ns) = case Integer
n Integer -> Integer -> (# Integer, Integer #)
`quotRemInteger` Integer
pow10 of
PAIR(r :: Integer
q,r) -> Integer
q Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: Integer
r Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: [Integer] -> [Integer]
splitb [Integer]
ns
putH :: [Integer] -> [Int]
putH :: [Integer] -> [Int]
putH [] = String -> [Int]
forall a. String -> a
errImpossible "putH"
putH (n :: Integer
n:ns :: [Integer]
ns) = case Integer
n Integer -> Integer -> (# Integer, Integer #)
`quotRemInteger` Integer
maxPow10 of
PAIR(y :: Integer
x,y)
| Int
q Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 -> Int
q Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: Int
r Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Integer] -> [Int]
putB [Integer]
ns
| Bool
otherwise -> Int
r Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Integer] -> [Int]
putB [Integer]
ns
where q :: Int
q = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
x
r :: Int
r = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
y
putB :: [Integer] -> [Int]
putB :: [Integer] -> [Int]
putB [] = []
putB (n :: Integer
n:ns :: [Integer]
ns) = case Integer
n Integer -> Integer -> (# Integer, Integer #)
`quotRemInteger` Integer
maxPow10 of
PAIR(r :: Integer
q,r) -> Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
q Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
r Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Integer] -> [Int]
putB [Integer]
ns
foreign import ccall unsafe "static _hs_bytestring_int_dec_padded9"
c_int_dec_padded9 :: CInt -> Ptr Word8 -> IO ()
foreign import ccall unsafe "static _hs_bytestring_long_long_int_dec_padded18"
c_long_long_int_dec_padded18 :: CLLong -> Ptr Word8 -> IO ()
{-# INLINE intDecPadded #-}
intDecPadded :: P.BoundedPrim Int
intDecPadded :: BoundedPrim Int
intDecPadded = FixedPrim Int -> BoundedPrim Int
forall a. FixedPrim a -> BoundedPrim a
P.liftFixedToBounded (FixedPrim Int -> BoundedPrim Int)
-> FixedPrim Int -> BoundedPrim Int
forall a b. (a -> b) -> a -> b
$ FixedPrim Int -> FixedPrim Int -> FixedPrim Int
forall a. a -> a -> a
caseWordSize_32_64
(Int -> (Int -> Ptr Word8 -> IO ()) -> FixedPrim Int
forall a. Int -> (a -> Ptr Word8 -> IO ()) -> FixedPrim a
P.fixedPrim 9 ((Int -> Ptr Word8 -> IO ()) -> FixedPrim Int)
-> (Int -> Ptr Word8 -> IO ()) -> FixedPrim Int
forall a b. (a -> b) -> a -> b
$ CInt -> Ptr Word8 -> IO ()
c_int_dec_padded9 (CInt -> Ptr Word8 -> IO ())
-> (Int -> CInt) -> Int -> Ptr Word8 -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
(Int -> (Int -> Ptr Word8 -> IO ()) -> FixedPrim Int
forall a. Int -> (a -> Ptr Word8 -> IO ()) -> FixedPrim a
P.fixedPrim 18 ((Int -> Ptr Word8 -> IO ()) -> FixedPrim Int)
-> (Int -> Ptr Word8 -> IO ()) -> FixedPrim Int
forall a b. (a -> b) -> a -> b
$ CLLong -> Ptr Word8 -> IO ()
c_long_long_int_dec_padded18 (CLLong -> Ptr Word8 -> IO ())
-> (Int -> CLLong) -> Int -> Ptr Word8 -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CLLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
intVLQ :: Int -> Builder
intVLQ :: Int -> Builder
intVLQ = BoundedPrim Int -> Int -> Builder
forall a. BoundedPrim a -> a -> Builder
primBounded BoundedPrim Int
intVLQBP
{-# INLINE intVLQ #-}
intVLQBP :: P.BoundedPrim Int
intVLQBP :: BoundedPrim Int
intVLQBP = Int -> (Int -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim Int
forall a.
Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
P.boudedPrim 10 Int -> Ptr Word8 -> IO (Ptr Word8)
writeIntFinite
{-# INLINE CONLIKE intVLQBP #-}
wordVLQ :: Word -> Builder
wordVLQ :: Word -> Builder
wordVLQ = BoundedPrim Word -> Word -> Builder
forall a. BoundedPrim a -> a -> Builder
primBounded BoundedPrim Word
wordVLQBP
wordVLQBP :: P.BoundedPrim Word
wordVLQBP :: BoundedPrim Word
wordVLQBP = Int -> (Word -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim Word
forall a.
Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
P.boudedPrim 10 ((Ptr Word8 -> IO (Ptr Word8))
-> Word -> Ptr Word8 -> IO (Ptr Word8)
forall a r.
(Bits a, Integral a) =>
(Ptr Word8 -> IO r) -> a -> Ptr Word8 -> IO r
writeUnsignedFinite Ptr Word8 -> IO (Ptr Word8)
forall (f :: * -> *) a. Applicative f => a -> f a
pure)
writeWord8 :: Word8 -> Ptr Word8 -> IO (Ptr Word8)
writeWord8 :: Word8 -> Ptr Word8 -> IO (Ptr Word8)
writeWord8 w :: Word8
w p :: Ptr Word8
p = do
Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
p Word8
w
Ptr Word8 -> IO (Ptr Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Word8 -> IO (Ptr Word8)) -> Ptr Word8 -> IO (Ptr Word8)
forall a b. (a -> b) -> a -> b
$! Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
p 1
writeIntFinite :: Int -> Ptr Word8 -> IO (Ptr Word8)
writeIntFinite :: Int -> Ptr Word8 -> IO (Ptr Word8)
writeIntFinite n :: Int
n
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = case Int -> Int
forall a. Num a => a -> a
negate Int
n of
n' :: Int
n'
| Int
n' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0x40 -> Word8 -> Ptr Word8 -> IO (Ptr Word8)
writeWord8 (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n' Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`setBit` 6)
| Bool
otherwise ->
Word8 -> Ptr Word8 -> IO (Ptr Word8)
writeWord8 (0xc0 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n') (Ptr Word8 -> IO (Ptr Word8))
-> (Ptr Word8 -> IO (Ptr Word8)) -> Ptr Word8 -> IO (Ptr Word8)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
(Ptr Word8 -> IO (Ptr Word8)) -> Int -> Ptr Word8 -> IO (Ptr Word8)
forall a r.
(Bits a, Integral a) =>
(Ptr Word8 -> IO r) -> a -> Ptr Word8 -> IO r
writeUnsignedFinite Ptr Word8 -> IO (Ptr Word8)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Int -> Int
forall a. Bits a => a -> Int -> a
unsafeShiftR Int
n' 6)
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0x40 = Word8 -> Ptr Word8 -> IO (Ptr Word8)
writeWord8 (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
| Bool
otherwise = Word8 -> Ptr Word8 -> IO (Ptr Word8)
writeWord8 (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`setBit` 7 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`clearBit` 6) (Ptr Word8 -> IO (Ptr Word8))
-> (Ptr Word8 -> IO (Ptr Word8)) -> Ptr Word8 -> IO (Ptr Word8)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
(Ptr Word8 -> IO (Ptr Word8)) -> Int -> Ptr Word8 -> IO (Ptr Word8)
forall a r.
(Bits a, Integral a) =>
(Ptr Word8 -> IO r) -> a -> Ptr Word8 -> IO r
writeUnsignedFinite Ptr Word8 -> IO (Ptr Word8)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Int -> Int
forall a. Bits a => a -> Int -> a
unsafeShiftR Int
n 6)
{-# INLINE writeIntFinite #-}
writeUnsignedFinite :: (Bits a, Integral a) => (Ptr Word8 -> IO r) -> a -> Ptr Word8 -> IO r
writeUnsignedFinite :: (Ptr Word8 -> IO r) -> a -> Ptr Word8 -> IO r
writeUnsignedFinite k :: Ptr Word8 -> IO r
k = a -> Ptr Word8 -> IO r
forall t. (Integral t, Bits t) => t -> Ptr Word8 -> IO r
go
where
go :: t -> Ptr Word8 -> IO r
go m :: t
m
| t
m t -> t -> Bool
forall a. Ord a => a -> a -> Bool
< 0x80 = Word8 -> Ptr Word8 -> IO (Ptr Word8)
writeWord8 (t -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral t
m) (Ptr Word8 -> IO (Ptr Word8))
-> (Ptr Word8 -> IO r) -> Ptr Word8 -> IO r
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Ptr Word8 -> IO r
k
| Bool
otherwise = Word8 -> Ptr Word8 -> IO (Ptr Word8)
writeWord8 (Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
setBit (t -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral t
m) 7) (Ptr Word8 -> IO (Ptr Word8))
-> (Ptr Word8 -> IO r) -> Ptr Word8 -> IO r
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> t -> Ptr Word8 -> IO r
go (t -> Int -> t
forall a. Bits a => a -> Int -> a
unsafeShiftR t
m 7)
{-# INLINE writeUnsignedFinite #-}
prefixVarInt :: Word -> Builder
prefixVarInt :: Word -> Builder
prefixVarInt = BoundedPrim Word -> Word -> Builder
forall a. BoundedPrim a -> a -> Builder
primBounded BoundedPrim Word
prefixVarIntBP
prefixVarIntBP :: P.BoundedPrim Word
prefixVarIntBP :: BoundedPrim Word
prefixVarIntBP = Int -> (Word -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim Word
forall a.
Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
P.boudedPrim 9 ((Word -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim Word)
-> (Word -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim Word
forall a b. (a -> b) -> a -> b
$ \x :: Word
x ptr0 :: Ptr Word8
ptr0 -> do
let bits :: Int
bits = 64 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Word -> Int
forall b. FiniteBits b => b -> Int
countLeadingZeros (Word
x Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. 1)
if Int
bits Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 56
then do
Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
ptr0 0
Ptr Word -> Word -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8 -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
ptr0 Ptr Any -> Int -> Ptr Word
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 1) Word
x
Ptr Word8 -> IO (Ptr Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Word8 -> IO (Ptr Word8)) -> Ptr Word8 -> IO (Ptr Word8)
forall a b. (a -> b) -> a -> b
$! Ptr Word8
ptr0 Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 9
else do
let bytes :: Int
bytes = 1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
bits Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 7
let end :: Ptr b
end = Ptr Word8
ptr0 Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
bytes
let go :: Ptr b -> t -> IO (Ptr b)
go ptr :: Ptr b
ptr n :: t
n
| Ptr b
ptr Ptr b -> Ptr b -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr b
forall b. Ptr b
end = Ptr b -> IO (Ptr b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ptr b
ptr
| Bool
otherwise = do
Ptr b -> b -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr b
ptr (t -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral t
n b -> b -> b
forall a. Bits a => a -> a -> a
.&. 0xff)
Ptr b -> t -> IO (Ptr b)
go (Ptr b
ptr Ptr b -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 1) (t
n t -> Int -> t
forall a. Bits a => a -> Int -> a
`shiftR` 8)
Ptr Word8 -> Word -> IO (Ptr Word8)
forall b t.
(Storable b, Integral t, Bits b, Bits t, Num b) =>
Ptr b -> t -> IO (Ptr b)
go Ptr Word8
ptr0 (Word -> IO (Ptr Word8)) -> Word -> IO (Ptr Word8)
forall a b. (a -> b) -> a -> b
$! (2 Word -> Word -> Word
forall a. Num a => a -> a -> a
* Word
x Word -> Word -> Word
forall a. Num a => a -> a -> a
+ 1) Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftL` (Int
bytes Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1)
{-# INLINE CONLIKE prefixVarIntBP #-}