{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE PatternSynonyms #-}
#include "cbor.h"
#if defined(OPTIMIZE_GMP) && defined(HAVE_GHC_BIGNUM)
{-# LANGUAGE UnboxedSums #-}
#endif
module Codec.CBOR.Write
( toBuilder
, toLazyByteString
, toStrictByteString
) where
import Data.Bits
import Data.Int
#if ! MIN_VERSION_base(4,11,0)
import Data.Monoid
#endif
import Data.Word
import Foreign.Ptr
import qualified Data.ByteString as S
import qualified Data.ByteString.Builder as B
import qualified Data.ByteString.Builder.Internal as BI
import Data.ByteString.Builder.Prim (condB, (>$<), (>*<))
import qualified Data.ByteString.Builder.Prim as P
import qualified Data.ByteString.Builder.Prim.Internal as PI
import qualified Data.ByteString.Lazy as L
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
#if MIN_VERSION_text(2,0,0)
import qualified Data.Text.Foreign as T
#endif
import Control.Exception.Base (assert)
import GHC.Exts
#if defined(OPTIMIZE_GMP)
#if defined(HAVE_GHC_BIGNUM)
import GHC.IO (IO(IO))
import qualified GHC.Num.Integer
import qualified GHC.Num.BigNat as Gmp
import qualified GHC.Num.BigNat
import GHC.Num.BigNat (BigNat)
#else
import qualified GHC.Integer.GMP.Internals as Gmp
import GHC.Integer.GMP.Internals (BigNat)
#endif
#endif
#if __GLASGOW_HASKELL__ < 710
import GHC.Word
#endif
import qualified Codec.CBOR.ByteArray.Sliced as BAS
import Codec.CBOR.Encoding
import Codec.CBOR.Magic
toLazyByteString :: Encoding
-> L.ByteString
toLazyByteString :: Encoding -> ByteString
toLazyByteString = Builder -> ByteString
B.toLazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Encoding -> Builder
toBuilder
toStrictByteString :: Encoding
-> S.ByteString
toStrictByteString :: Encoding -> ByteString
toStrictByteString = ByteString -> ByteString
L.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
B.toLazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Encoding -> Builder
toBuilder
toBuilder :: Encoding
-> B.Builder
toBuilder :: Encoding -> Builder
toBuilder =
\(Encoding Tokens -> Tokens
vs0) -> (forall r. BuildStep r -> BuildStep r) -> Builder
BI.builder (forall a.
Tokens
-> (BufferRange -> IO (BuildSignal a))
-> BufferRange
-> IO (BuildSignal a)
buildStep (Tokens -> Tokens
vs0 Tokens
TkEnd))
buildStep :: Tokens
-> (BI.BufferRange -> IO (BI.BuildSignal a))
-> BI.BufferRange
-> IO (BI.BuildSignal a)
buildStep :: forall a.
Tokens
-> (BufferRange -> IO (BuildSignal a))
-> BufferRange
-> IO (BuildSignal a)
buildStep Tokens
vs1 BufferRange -> IO (BuildSignal a)
k (BI.BufferRange Ptr Word8
op0 Ptr Word8
ope0) =
Tokens -> Ptr Word8 -> IO (BuildSignal a)
go Tokens
vs1 Ptr Word8
op0
where
go :: Tokens -> Ptr Word8 -> IO (BuildSignal a)
go Tokens
vs !Ptr Word8
op
| Ptr Word8
op forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
bound forall a. Ord a => a -> a -> Bool
<= Ptr Word8
ope0 = case Tokens
vs of
TkWord Word
x Tokens
vs' -> forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim Word
wordMP Word
x Ptr Word8
op forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tokens -> Ptr Word8 -> IO (BuildSignal a)
go Tokens
vs'
TkWord64 Word64
x Tokens
vs' -> forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim Word64
word64MP Word64
x Ptr Word8
op forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tokens -> Ptr Word8 -> IO (BuildSignal a)
go Tokens
vs'
TkInt Int
x Tokens
vs' -> forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim Int
intMP Int
x Ptr Word8
op forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tokens -> Ptr Word8 -> IO (BuildSignal a)
go Tokens
vs'
TkInt64 Int64
x Tokens
vs' -> forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim Int64
int64MP Int64
x Ptr Word8
op forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tokens -> Ptr Word8 -> IO (BuildSignal a)
go Tokens
vs'
TkBytes ByteString
x Tokens
vs' -> forall a. Builder -> BuildStep a -> BuildStep a
BI.runBuilderWith
(ByteString -> Builder
bytesMP ByteString
x) (forall a.
Tokens
-> (BufferRange -> IO (BuildSignal a))
-> BufferRange
-> IO (BuildSignal a)
buildStep Tokens
vs' BufferRange -> IO (BuildSignal a)
k)
(Ptr Word8 -> Ptr Word8 -> BufferRange
BI.BufferRange Ptr Word8
op Ptr Word8
ope0)
TkByteArray SlicedByteArray
x Tokens
vs' -> forall a. Builder -> BuildStep a -> BuildStep a
BI.runBuilderWith
(SlicedByteArray -> Builder
byteArrayMP SlicedByteArray
x) (forall a.
Tokens
-> (BufferRange -> IO (BuildSignal a))
-> BufferRange
-> IO (BuildSignal a)
buildStep Tokens
vs' BufferRange -> IO (BuildSignal a)
k)
(Ptr Word8 -> Ptr Word8 -> BufferRange
BI.BufferRange Ptr Word8
op Ptr Word8
ope0)
TkUtf8ByteArray SlicedByteArray
x Tokens
vs' -> forall a. Builder -> BuildStep a -> BuildStep a
BI.runBuilderWith
(SlicedByteArray -> Builder
utf8ByteArrayMP SlicedByteArray
x) (forall a.
Tokens
-> (BufferRange -> IO (BuildSignal a))
-> BufferRange
-> IO (BuildSignal a)
buildStep Tokens
vs' BufferRange -> IO (BuildSignal a)
k)
(Ptr Word8 -> Ptr Word8 -> BufferRange
BI.BufferRange Ptr Word8
op Ptr Word8
ope0)
TkString Text
x Tokens
vs' -> forall a. Builder -> BuildStep a -> BuildStep a
BI.runBuilderWith
(Text -> Builder
stringMP Text
x) (forall a.
Tokens
-> (BufferRange -> IO (BuildSignal a))
-> BufferRange
-> IO (BuildSignal a)
buildStep Tokens
vs' BufferRange -> IO (BuildSignal a)
k)
(Ptr Word8 -> Ptr Word8 -> BufferRange
BI.BufferRange Ptr Word8
op Ptr Word8
ope0)
TkBytesBegin Tokens
vs' -> forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim ()
bytesBeginMP () Ptr Word8
op forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tokens -> Ptr Word8 -> IO (BuildSignal a)
go Tokens
vs'
TkStringBegin Tokens
vs'-> forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim ()
stringBeginMP () Ptr Word8
op forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tokens -> Ptr Word8 -> IO (BuildSignal a)
go Tokens
vs'
TkListLen Word
x Tokens
vs' -> forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim Word
arrayLenMP Word
x Ptr Word8
op forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tokens -> Ptr Word8 -> IO (BuildSignal a)
go Tokens
vs'
TkListBegin Tokens
vs' -> forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim ()
arrayBeginMP () Ptr Word8
op forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tokens -> Ptr Word8 -> IO (BuildSignal a)
go Tokens
vs'
TkMapLen Word
x Tokens
vs' -> forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim Word
mapLenMP Word
x Ptr Word8
op forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tokens -> Ptr Word8 -> IO (BuildSignal a)
go Tokens
vs'
TkMapBegin Tokens
vs' -> forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim ()
mapBeginMP () Ptr Word8
op forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tokens -> Ptr Word8 -> IO (BuildSignal a)
go Tokens
vs'
TkTag Word
x Tokens
vs' -> forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim Word
tagMP Word
x Ptr Word8
op forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tokens -> Ptr Word8 -> IO (BuildSignal a)
go Tokens
vs'
TkTag64 Word64
x Tokens
vs' -> forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim Word64
tag64MP Word64
x Ptr Word8
op forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tokens -> Ptr Word8 -> IO (BuildSignal a)
go Tokens
vs'
#if defined(OPTIMIZE_GMP)
TkInteger (SmallInt Int#
i) Tokens
vs' ->
forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim Int
intMP (Int# -> Int
I# Int#
i) Ptr Word8
op forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tokens -> Ptr Word8 -> IO (BuildSignal a)
go Tokens
vs'
TkInteger integer :: Integer
integer@(PosBigInt BigNat#
bigNat) Tokens
vs'
| Integer
integer forall a. Ord a => a -> a -> Bool
<= forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: Word64) ->
forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim Word64
word64MP (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
integer) Ptr Word8
op forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tokens -> Ptr Word8 -> IO (BuildSignal a)
go Tokens
vs'
| Bool
otherwise ->
let buffer :: BufferRange
buffer = Ptr Word8 -> Ptr Word8 -> BufferRange
BI.BufferRange Ptr Word8
op Ptr Word8
ope0
in forall a. Builder -> BuildStep a -> BuildStep a
BI.runBuilderWith
(BigNat# -> Builder
bigNatMP BigNat#
bigNat) (forall a.
Tokens
-> (BufferRange -> IO (BuildSignal a))
-> BufferRange
-> IO (BuildSignal a)
buildStep Tokens
vs' BufferRange -> IO (BuildSignal a)
k) BufferRange
buffer
TkInteger integer :: Integer
integer@(NegBigInt BigNat#
bigNat) Tokens
vs'
| Integer
integer forall a. Ord a => a -> a -> Bool
>= -Integer
1 forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: Word64) ->
forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim Word64
negInt64MP (forall a b. (Integral a, Num b) => a -> b
fromIntegral (-Integer
1 forall a. Num a => a -> a -> a
- Integer
integer)) Ptr Word8
op forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tokens -> Ptr Word8 -> IO (BuildSignal a)
go Tokens
vs'
| Bool
otherwise ->
let buffer :: BufferRange
buffer = Ptr Word8 -> Ptr Word8 -> BufferRange
BI.BufferRange Ptr Word8
op Ptr Word8
ope0
in forall a. Builder -> BuildStep a -> BuildStep a
BI.runBuilderWith
(BigNat# -> Builder
negBigNatMP BigNat#
bigNat) (forall a.
Tokens
-> (BufferRange -> IO (BuildSignal a))
-> BufferRange
-> IO (BuildSignal a)
buildStep Tokens
vs' BufferRange -> IO (BuildSignal a)
k) BufferRange
buffer
#else
TkInteger x vs'
| x >= 0
, x <= fromIntegral (maxBound :: Word64)
-> PI.runB word64MP (fromIntegral x) op >>= go vs'
| x < 0
, x >= -1 - fromIntegral (maxBound :: Word64)
-> PI.runB negInt64MP (fromIntegral (-1 - x)) op >>= go vs'
| otherwise -> BI.runBuilderWith
(integerMP x) (buildStep vs' k)
(BI.BufferRange op ope0)
#endif
TkBool Bool
False Tokens
vs' -> forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim ()
falseMP () Ptr Word8
op forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tokens -> Ptr Word8 -> IO (BuildSignal a)
go Tokens
vs'
TkBool Bool
True Tokens
vs' -> forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim ()
trueMP () Ptr Word8
op forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tokens -> Ptr Word8 -> IO (BuildSignal a)
go Tokens
vs'
TkNull Tokens
vs' -> forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim ()
nullMP () Ptr Word8
op forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tokens -> Ptr Word8 -> IO (BuildSignal a)
go Tokens
vs'
TkUndef Tokens
vs' -> forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim ()
undefMP () Ptr Word8
op forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tokens -> Ptr Word8 -> IO (BuildSignal a)
go Tokens
vs'
TkSimple Word8
w Tokens
vs' -> forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim Word8
simpleMP Word8
w Ptr Word8
op forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tokens -> Ptr Word8 -> IO (BuildSignal a)
go Tokens
vs'
TkFloat16 Float
f Tokens
vs' -> forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim Float
halfMP Float
f Ptr Word8
op forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tokens -> Ptr Word8 -> IO (BuildSignal a)
go Tokens
vs'
TkFloat32 Float
f Tokens
vs' -> forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim Float
floatMP Float
f Ptr Word8
op forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tokens -> Ptr Word8 -> IO (BuildSignal a)
go Tokens
vs'
TkFloat64 Double
f Tokens
vs' -> forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim Double
doubleMP Double
f Ptr Word8
op forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tokens -> Ptr Word8 -> IO (BuildSignal a)
go Tokens
vs'
TkBreak Tokens
vs' -> forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
PI.runB BoundedPrim ()
breakMP () Ptr Word8
op forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tokens -> Ptr Word8 -> IO (BuildSignal a)
go Tokens
vs'
TkEncoded ByteString
x Tokens
vs' -> forall a. Builder -> BuildStep a -> BuildStep a
BI.runBuilderWith
(ByteString -> Builder
B.byteString ByteString
x) (forall a.
Tokens
-> (BufferRange -> IO (BuildSignal a))
-> BufferRange
-> IO (BuildSignal a)
buildStep Tokens
vs' BufferRange -> IO (BuildSignal a)
k)
(Ptr Word8 -> Ptr Word8 -> BufferRange
BI.BufferRange Ptr Word8
op Ptr Word8
ope0)
Tokens
TkEnd -> BufferRange -> IO (BuildSignal a)
k (Ptr Word8 -> Ptr Word8 -> BufferRange
BI.BufferRange Ptr Word8
op Ptr Word8
ope0)
| Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Int -> Ptr Word8 -> BuildStep a -> BuildSignal a
BI.bufferFull Int
bound Ptr Word8
op (forall a.
Tokens
-> (BufferRange -> IO (BuildSignal a))
-> BufferRange
-> IO (BuildSignal a)
buildStep Tokens
vs BufferRange -> IO (BuildSignal a)
k)
bound :: Int
bound :: Int
bound = Int
9
header :: P.BoundedPrim Word8
= forall a. FixedPrim a -> BoundedPrim a
P.liftFixedToBounded FixedPrim Word8
P.word8
constHeader :: Word8 -> P.BoundedPrim ()
Word8
h = forall a. FixedPrim a -> BoundedPrim a
P.liftFixedToBounded (forall a b. a -> b -> a
const Word8
h forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< FixedPrim Word8
P.word8)
withHeader :: P.FixedPrim a -> P.BoundedPrim (Word8, a)
FixedPrim a
p = forall a. FixedPrim a -> BoundedPrim a
P.liftFixedToBounded (FixedPrim Word8
P.word8 forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim a
p)
withConstHeader :: Word8 -> P.FixedPrim a -> P.BoundedPrim a
Word8
h FixedPrim a
p = forall a. FixedPrim a -> BoundedPrim a
P.liftFixedToBounded ((,) Word8
h forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< (FixedPrim Word8
P.word8 forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim a
p))
{-# INLINE wordMP #-}
wordMP :: P.BoundedPrim Word
wordMP :: BoundedPrim Word
wordMP =
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word
0x17) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< BoundedPrim Word8
header) forall a b. (a -> b) -> a -> b
$
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word
0xff) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
24 FixedPrim Word8
P.word8) forall a b. (a -> b) -> a -> b
$
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word
0xffff) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
25 FixedPrim Word16
P.word16BE) forall a b. (a -> b) -> a -> b
$
#if defined(ARCH_64bit)
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word
0xffffffff) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
26 FixedPrim Word32
P.word32BE) forall a b. (a -> b) -> a -> b
$
(forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
27 FixedPrim Word64
P.word64BE)
#else
(fromIntegral >$< withConstHeader 26 P.word32BE)
#endif
{-# INLINE word64MP #-}
word64MP :: P.BoundedPrim Word64
word64MP :: BoundedPrim Word64
word64MP =
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word64
0x17) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< BoundedPrim Word8
header) forall a b. (a -> b) -> a -> b
$
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word64
0xff) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
24 FixedPrim Word8
P.word8) forall a b. (a -> b) -> a -> b
$
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word64
0xffff) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
25 FixedPrim Word16
P.word16BE) forall a b. (a -> b) -> a -> b
$
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word64
0xffffffff) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
26 FixedPrim Word32
P.word32BE) forall a b. (a -> b) -> a -> b
$
(forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
27 FixedPrim Word64
P.word64BE)
negInt64MP :: P.BoundedPrim Word64
negInt64MP :: BoundedPrim Word64
negInt64MP =
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word64
0x17) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64
0x20 forall a. Num a => a -> a -> a
+) forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< BoundedPrim Word8
header) forall a b. (a -> b) -> a -> b
$
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word64
0xff) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0x38 FixedPrim Word8
P.word8) forall a b. (a -> b) -> a -> b
$
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word64
0xffff) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0x39 FixedPrim Word16
P.word16BE) forall a b. (a -> b) -> a -> b
$
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word64
0xffffffff) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0x3a FixedPrim Word32
P.word32BE) forall a b. (a -> b) -> a -> b
$
(forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0x3b FixedPrim Word64
P.word64BE)
{-# INLINE intMP #-}
intMP :: P.BoundedPrim Int
intMP :: BoundedPrim Int
intMP =
Int -> (Word8, Word)
prep forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< (
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB ((forall a. Ord a => a -> a -> Bool
<= Word
0x17) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) ((Word8, Word) -> Word8
encIntSmall forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< BoundedPrim Word8
header) forall a b. (a -> b) -> a -> b
$
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB ((forall a. Ord a => a -> a -> Bool
<= Word
0xff) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) (forall {a} {a} {b}. (Integral a, Num a, Num b) => (a, a) -> (a, b)
encInt8 forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. FixedPrim a -> BoundedPrim (Word8, a)
withHeader FixedPrim Word8
P.word8) forall a b. (a -> b) -> a -> b
$
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB ((forall a. Ord a => a -> a -> Bool
<= Word
0xffff) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) (forall {a} {a} {b}. (Integral a, Num a, Num b) => (a, a) -> (a, b)
encInt16 forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. FixedPrim a -> BoundedPrim (Word8, a)
withHeader FixedPrim Word16
P.word16BE) forall a b. (a -> b) -> a -> b
$
#if defined(ARCH_64bit)
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB ((forall a. Ord a => a -> a -> Bool
<= Word
0xffffffff) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) (forall {a} {a} {b}. (Integral a, Num a, Num b) => (a, a) -> (a, b)
encInt32 forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. FixedPrim a -> BoundedPrim (Word8, a)
withHeader FixedPrim Word32
P.word32BE)
(forall {a} {a} {b}. (Integral a, Num a, Num b) => (a, a) -> (a, b)
encInt64 forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. FixedPrim a -> BoundedPrim (Word8, a)
withHeader FixedPrim Word64
P.word64BE)
#else
(encInt32 >$< withHeader P.word32BE)
#endif
)
where
prep :: Int -> (Word8, Word)
prep :: Int -> (Word8, Word)
prep Int
n = (Word8
mt, Word
ui)
where
sign :: Word
sign :: Word
sign = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
n forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
intBits)
#if MIN_VERSION_base(4,7,0)
intBits :: Int
intBits = forall b. FiniteBits b => b -> Int
finiteBitSize (forall a. HasCallStack => a
undefined :: Int) forall a. Num a => a -> a -> a
- Int
1
#else
intBits = bitSize (undefined :: Int) - 1
#endif
mt :: Word8
mt :: Word8
mt = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word
sign forall a. Bits a => a -> a -> a
.&. Word
0x20)
ui :: Word
ui :: Word
ui = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n forall a. Bits a => a -> a -> a
`xor` Word
sign
encIntSmall :: (Word8, Word) -> Word8
encIntSmall :: (Word8, Word) -> Word8
encIntSmall (Word8
mt, Word
ui) = Word8
mt forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
ui
encInt8 :: (a, a) -> (a, b)
encInt8 (a
mt, a
ui) = (a
mt forall a. Num a => a -> a -> a
+ a
24, forall a b. (Integral a, Num b) => a -> b
fromIntegral a
ui)
encInt16 :: (a, a) -> (a, b)
encInt16 (a
mt, a
ui) = (a
mt forall a. Num a => a -> a -> a
+ a
25, forall a b. (Integral a, Num b) => a -> b
fromIntegral a
ui)
encInt32 :: (a, a) -> (a, b)
encInt32 (a
mt, a
ui) = (a
mt forall a. Num a => a -> a -> a
+ a
26, forall a b. (Integral a, Num b) => a -> b
fromIntegral a
ui)
#if defined(ARCH_64bit)
encInt64 :: (a, a) -> (a, b)
encInt64 (a
mt, a
ui) = (a
mt forall a. Num a => a -> a -> a
+ a
27, forall a b. (Integral a, Num b) => a -> b
fromIntegral a
ui)
#endif
{-# INLINE int64MP #-}
int64MP :: P.BoundedPrim Int64
int64MP :: BoundedPrim Int64
int64MP =
Int64 -> (Word8, Word64)
prep forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< (
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB ((forall a. Ord a => a -> a -> Bool
<= Word64
0x17) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) (forall {a} {a}. (Integral a, Num a) => (a, a) -> a
encIntSmall forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< BoundedPrim Word8
header) forall a b. (a -> b) -> a -> b
$
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB ((forall a. Ord a => a -> a -> Bool
<= Word64
0xff) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) (forall {a} {a} {b}. (Integral a, Num a, Num b) => (a, a) -> (a, b)
encInt8 forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. FixedPrim a -> BoundedPrim (Word8, a)
withHeader FixedPrim Word8
P.word8) forall a b. (a -> b) -> a -> b
$
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB ((forall a. Ord a => a -> a -> Bool
<= Word64
0xffff) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) (forall {a} {a} {b}. (Integral a, Num a, Num b) => (a, a) -> (a, b)
encInt16 forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. FixedPrim a -> BoundedPrim (Word8, a)
withHeader FixedPrim Word16
P.word16BE) forall a b. (a -> b) -> a -> b
$
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB ((forall a. Ord a => a -> a -> Bool
<= Word64
0xffffffff) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) (forall {a} {a} {b}. (Integral a, Num a, Num b) => (a, a) -> (a, b)
encInt32 forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. FixedPrim a -> BoundedPrim (Word8, a)
withHeader FixedPrim Word32
P.word32BE)
(forall {a} {a} {b}. (Integral a, Num a, Num b) => (a, a) -> (a, b)
encInt64 forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. FixedPrim a -> BoundedPrim (Word8, a)
withHeader FixedPrim Word64
P.word64BE)
)
where
prep :: Int64 -> (Word8, Word64)
prep :: Int64 -> (Word8, Word64)
prep Int64
n = (Word8
mt, Word64
ui)
where
sign :: Word64
sign :: Word64
sign = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64
n forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
intBits)
#if MIN_VERSION_base(4,7,0)
intBits :: Int
intBits = forall b. FiniteBits b => b -> Int
finiteBitSize (forall a. HasCallStack => a
undefined :: Int64) forall a. Num a => a -> a -> a
- Int
1
#else
intBits = bitSize (undefined :: Int64) - 1
#endif
mt :: Word8
mt :: Word8
mt = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
sign forall a. Bits a => a -> a -> a
.&. Word64
0x20)
ui :: Word64
ui :: Word64
ui = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
n forall a. Bits a => a -> a -> a
`xor` Word64
sign
encIntSmall :: (a, a) -> a
encIntSmall (a
mt, a
ui) = a
mt forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral a
ui
encInt8 :: (a, a) -> (a, b)
encInt8 (a
mt, a
ui) = (a
mt forall a. Num a => a -> a -> a
+ a
24, forall a b. (Integral a, Num b) => a -> b
fromIntegral a
ui)
encInt16 :: (a, a) -> (a, b)
encInt16 (a
mt, a
ui) = (a
mt forall a. Num a => a -> a -> a
+ a
25, forall a b. (Integral a, Num b) => a -> b
fromIntegral a
ui)
encInt32 :: (a, a) -> (a, b)
encInt32 (a
mt, a
ui) = (a
mt forall a. Num a => a -> a -> a
+ a
26, forall a b. (Integral a, Num b) => a -> b
fromIntegral a
ui)
encInt64 :: (a, a) -> (a, b)
encInt64 (a
mt, a
ui) = (a
mt forall a. Num a => a -> a -> a
+ a
27, forall a b. (Integral a, Num b) => a -> b
fromIntegral a
ui)
bytesMP :: S.ByteString -> B.Builder
bytesMP :: ByteString -> Builder
bytesMP ByteString
bs =
forall a. BoundedPrim a -> a -> Builder
P.primBounded BoundedPrim Word
bytesLenMP (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ByteString -> Int
S.length ByteString
bs) forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
B.byteString ByteString
bs
bytesLenMP :: P.BoundedPrim Word
bytesLenMP :: BoundedPrim Word
bytesLenMP =
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word
0x17) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word
0x40 forall a. Num a => a -> a -> a
+) forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< BoundedPrim Word8
header) forall a b. (a -> b) -> a -> b
$
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word
0xff) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0x58 FixedPrim Word8
P.word8) forall a b. (a -> b) -> a -> b
$
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word
0xffff) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0x59 FixedPrim Word16
P.word16BE) forall a b. (a -> b) -> a -> b
$
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word
0xffffffff) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0x5a FixedPrim Word32
P.word32BE) forall a b. (a -> b) -> a -> b
$
(forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0x5b FixedPrim Word64
P.word64BE)
byteArrayMP :: BAS.SlicedByteArray -> B.Builder
byteArrayMP :: SlicedByteArray -> Builder
byteArrayMP SlicedByteArray
ba =
forall a. BoundedPrim a -> a -> Builder
P.primBounded BoundedPrim Word
bytesLenMP Word
n forall a. Semigroup a => a -> a -> a
<> SlicedByteArray -> Builder
BAS.toBuilder SlicedByteArray
ba
where n :: Word
n = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ SlicedByteArray -> Int
BAS.sizeofSlicedByteArray SlicedByteArray
ba
bytesBeginMP :: P.BoundedPrim ()
bytesBeginMP :: BoundedPrim ()
bytesBeginMP = Word8 -> BoundedPrim ()
constHeader Word8
0x5f
stringMP :: T.Text -> B.Builder
stringMP :: Text -> Builder
stringMP Text
t =
#if MIN_VERSION_text(2,0,0)
P.primBounded stringLenMP (fromIntegral $ T.lengthWord8 t) <> T.encodeUtf8Builder t
#else
forall a. BoundedPrim a -> a -> Builder
P.primBounded BoundedPrim Word
stringLenMP (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ByteString -> Int
S.length ByteString
bs) forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
B.byteString ByteString
bs
where
bs :: ByteString
bs = Text -> ByteString
T.encodeUtf8 Text
t
#endif
stringLenMP :: P.BoundedPrim Word
stringLenMP :: BoundedPrim Word
stringLenMP =
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word
0x17) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word
0x60 forall a. Num a => a -> a -> a
+) forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< BoundedPrim Word8
header) forall a b. (a -> b) -> a -> b
$
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word
0xff) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0x78 FixedPrim Word8
P.word8) forall a b. (a -> b) -> a -> b
$
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word
0xffff) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0x79 FixedPrim Word16
P.word16BE) forall a b. (a -> b) -> a -> b
$
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word
0xffffffff) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0x7a FixedPrim Word32
P.word32BE) forall a b. (a -> b) -> a -> b
$
(forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0x7b FixedPrim Word64
P.word64BE)
stringBeginMP :: P.BoundedPrim ()
stringBeginMP :: BoundedPrim ()
stringBeginMP = Word8 -> BoundedPrim ()
constHeader Word8
0x7f
utf8ByteArrayMP :: BAS.SlicedByteArray -> B.Builder
utf8ByteArrayMP :: SlicedByteArray -> Builder
utf8ByteArrayMP SlicedByteArray
t =
forall a. BoundedPrim a -> a -> Builder
P.primBounded BoundedPrim Word
stringLenMP Word
n forall a. Semigroup a => a -> a -> a
<> SlicedByteArray -> Builder
BAS.toBuilder SlicedByteArray
t
where
n :: Word
n = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ SlicedByteArray -> Int
BAS.sizeofSlicedByteArray SlicedByteArray
t
arrayLenMP :: P.BoundedPrim Word
arrayLenMP :: BoundedPrim Word
arrayLenMP =
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word
0x17) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word
0x80 forall a. Num a => a -> a -> a
+) forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< BoundedPrim Word8
header) forall a b. (a -> b) -> a -> b
$
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word
0xff) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0x98 FixedPrim Word8
P.word8) forall a b. (a -> b) -> a -> b
$
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word
0xffff) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0x99 FixedPrim Word16
P.word16BE) forall a b. (a -> b) -> a -> b
$
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word
0xffffffff) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0x9a FixedPrim Word32
P.word32BE) forall a b. (a -> b) -> a -> b
$
(forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0x9b FixedPrim Word64
P.word64BE)
arrayBeginMP :: P.BoundedPrim ()
arrayBeginMP :: BoundedPrim ()
arrayBeginMP = Word8 -> BoundedPrim ()
constHeader Word8
0x9f
mapLenMP :: P.BoundedPrim Word
mapLenMP :: BoundedPrim Word
mapLenMP =
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word
0x17) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word
0xa0 forall a. Num a => a -> a -> a
+) forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< BoundedPrim Word8
header) forall a b. (a -> b) -> a -> b
$
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word
0xff) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0xb8 FixedPrim Word8
P.word8) forall a b. (a -> b) -> a -> b
$
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word
0xffff) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0xb9 FixedPrim Word16
P.word16BE) forall a b. (a -> b) -> a -> b
$
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word
0xffffffff) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0xba FixedPrim Word32
P.word32BE) forall a b. (a -> b) -> a -> b
$
(forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0xbb FixedPrim Word64
P.word64BE)
mapBeginMP :: P.BoundedPrim ()
mapBeginMP :: BoundedPrim ()
mapBeginMP = Word8 -> BoundedPrim ()
constHeader Word8
0xbf
tagMP :: P.BoundedPrim Word
tagMP :: BoundedPrim Word
tagMP =
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word
0x17) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word
0xc0 forall a. Num a => a -> a -> a
+) forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< BoundedPrim Word8
header) forall a b. (a -> b) -> a -> b
$
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word
0xff) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0xd8 FixedPrim Word8
P.word8) forall a b. (a -> b) -> a -> b
$
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word
0xffff) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0xd9 FixedPrim Word16
P.word16BE) forall a b. (a -> b) -> a -> b
$
#if defined(ARCH_64bit)
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word
0xffffffff) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0xda FixedPrim Word32
P.word32BE) forall a b. (a -> b) -> a -> b
$
(forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0xdb FixedPrim Word64
P.word64BE)
#else
(fromIntegral >$< withConstHeader 0xda P.word32BE)
#endif
tag64MP :: P.BoundedPrim Word64
tag64MP :: BoundedPrim Word64
tag64MP =
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word64
0x17) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64
0xc0 forall a. Num a => a -> a -> a
+) forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< BoundedPrim Word8
header) forall a b. (a -> b) -> a -> b
$
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word64
0xff) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0xd8 FixedPrim Word8
P.word8) forall a b. (a -> b) -> a -> b
$
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word64
0xffff) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0xd9 FixedPrim Word16
P.word16BE) forall a b. (a -> b) -> a -> b
$
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word64
0xffffffff) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0xda FixedPrim Word32
P.word32BE) forall a b. (a -> b) -> a -> b
$
(forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0xdb FixedPrim Word64
P.word64BE)
simpleMP :: P.BoundedPrim Word8
simpleMP :: BoundedPrim Word8
simpleMP =
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (forall a. Ord a => a -> a -> Bool
<= Word8
0x17) ((Word8
0xe0 forall a. Num a => a -> a -> a
+) forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< BoundedPrim Word8
header) forall a b. (a -> b) -> a -> b
$
(forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0xf8 FixedPrim Word8
P.word8)
falseMP :: P.BoundedPrim ()
falseMP :: BoundedPrim ()
falseMP = Word8 -> BoundedPrim ()
constHeader Word8
0xf4
trueMP :: P.BoundedPrim ()
trueMP :: BoundedPrim ()
trueMP = Word8 -> BoundedPrim ()
constHeader Word8
0xf5
nullMP :: P.BoundedPrim ()
nullMP :: BoundedPrim ()
nullMP = Word8 -> BoundedPrim ()
constHeader Word8
0xf6
undefMP :: P.BoundedPrim ()
undefMP :: BoundedPrim ()
undefMP = Word8 -> BoundedPrim ()
constHeader Word8
0xf7
canonicalNaN :: PI.BoundedPrim a
canonicalNaN :: forall a. BoundedPrim a
canonicalNaN = forall a. FixedPrim a -> BoundedPrim a
P.liftFixedToBounded forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const (Word8
0xf9, (Word8
0x7e, Word8
0x00))
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< FixedPrim Word8
P.word8 forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Word8
P.word8 forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Word8
P.word8
halfMP :: P.BoundedPrim Float
halfMP :: BoundedPrim Float
halfMP = forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB forall a. RealFloat a => a -> Bool
isNaN forall a. BoundedPrim a
canonicalNaN
(Float -> Word16
floatToWord16 forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0xf9 FixedPrim Word16
P.word16BE)
floatMP :: P.BoundedPrim Float
floatMP :: BoundedPrim Float
floatMP = forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB forall a. RealFloat a => a -> Bool
isNaN forall a. BoundedPrim a
canonicalNaN
(forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0xfa FixedPrim Float
P.floatBE)
doubleMP :: P.BoundedPrim Double
doubleMP :: BoundedPrim Double
doubleMP = forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB forall a. RealFloat a => a -> Bool
isNaN forall a. BoundedPrim a
canonicalNaN
(forall a. Word8 -> FixedPrim a -> BoundedPrim a
withConstHeader Word8
0xfb FixedPrim Double
P.doubleBE)
breakMP :: P.BoundedPrim ()
breakMP :: BoundedPrim ()
breakMP = Word8 -> BoundedPrim ()
constHeader Word8
0xff
#if defined(OPTIMIZE_GMP)
exportBigNatToAddr :: BigNat -> Addr# -> IO Word
#if defined(HAVE_GHC_BIGNUM)
{-# COMPLETE SmallInt, PosBigInt, NegBigInt #-}
pattern SmallInt :: Int# -> Integer
pattern $bSmallInt :: Int# -> Integer
$mSmallInt :: forall {r}. Integer -> (Int# -> r) -> ((# #) -> r) -> r
SmallInt n = GHC.Num.Integer.IS n
pattern PosBigInt, NegBigInt :: GHC.Num.BigNat.BigNat# -> Integer
pattern $bPosBigInt :: BigNat# -> Integer
$mPosBigInt :: forall {r}. Integer -> (BigNat# -> r) -> ((# #) -> r) -> r
PosBigInt n = GHC.Num.Integer.IP n
pattern $bNegBigInt :: BigNat# -> Integer
$mNegBigInt :: forall {r}. Integer -> (BigNat# -> r) -> ((# #) -> r) -> r
NegBigInt n = GHC.Num.Integer.IN n
bigNatSizeInBytes :: GHC.Num.BigNat.BigNat -> Word
bigNatSizeInBytes :: BigNat -> Word
bigNatSizeInBytes BigNat
bigNat =
Word -> BigNat# -> Word
Gmp.bigNatSizeInBase Word
256 (BigNat -> BigNat#
GHC.Num.BigNat.unBigNat BigNat
bigNat)
bigNatMP :: GHC.Num.BigNat.BigNat# -> B.Builder
bigNatMP :: BigNat# -> Builder
bigNatMP BigNat#
n = forall a. BoundedPrim a -> a -> Builder
P.primBounded BoundedPrim Word8
header Word8
0xc2 forall a. Semigroup a => a -> a -> a
<> BigNat -> Builder
bigNatToBuilder (BigNat# -> BigNat
GHC.Num.BigNat.BN# BigNat#
n)
negBigNatMP :: GHC.Num.BigNat.BigNat# -> B.Builder
negBigNatMP :: BigNat# -> Builder
negBigNatMP BigNat#
n =
forall a. BoundedPrim a -> a -> Builder
P.primBounded BoundedPrim Word8
header Word8
0xc3
forall a. Semigroup a => a -> a -> a
<> BigNat -> Builder
bigNatToBuilder (BigNat -> BigNat
subtractOneBigNat (BigNat# -> BigNat
GHC.Num.BigNat.BN# BigNat#
n))
where
subtractOneBigNat :: BigNat -> BigNat
subtractOneBigNat (GHC.Num.BigNat.BN# BigNat#
nat) =
case BigNat# -> Word# -> (# (# #) | BigNat# #)
GHC.Num.BigNat.bigNatSubWord# BigNat#
nat Word#
1## of
(# | BigNat#
r #) -> BigNat# -> BigNat
GHC.Num.BigNat.BN# BigNat#
r
(# (# #) | #) -> forall a. HasCallStack => [Char] -> a
error [Char]
"subtractOneBigNat: impossible"
exportBigNatToAddr :: BigNat -> Addr# -> IO Word
exportBigNatToAddr (GHC.Num.BigNat.BN# BigNat#
b) Addr#
addr = forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s ->
case forall s.
BigNat# -> Addr# -> Int# -> State# s -> (# State# s, Word# #)
GHC.Num.BigNat.bigNatToAddr# BigNat#
b Addr#
addr Int#
1# State# RealWorld
s of
(# State# RealWorld
s', Word#
w #) -> (# State# RealWorld
s', Word# -> Word
W# Word#
w #)
#else /* HAVE_GHC_BIGNUM */
{-# COMPLETE SmallInt, PosBigInt, NegBigInt #-}
pattern SmallInt :: Int# -> Integer
pattern SmallInt n = Gmp.S# n
pattern PosBigInt :: BigNat -> Integer
pattern NegBigInt :: BigNat -> Integer
pattern PosBigInt n = Gmp.Jp# n
pattern NegBigInt n = Gmp.Jn# n
bigNatSizeInBytes :: BigNat -> Word
bigNatSizeInBytes bigNat = W# (Gmp.sizeInBaseBigNat bigNat 256#)
bigNatMP :: BigNat -> B.Builder
bigNatMP n = P.primBounded header 0xc2 <> bigNatToBuilder n
negBigNatMP :: BigNat -> B.Builder
negBigNatMP n =
P.primBounded header 0xc3
<> bigNatToBuilder (subtractOneBigNat n)
where
subtractOneBigNat m = Gmp.minusBigNatWord m (int2Word# 1#)
exportBigNatToAddr bigNat addr# =
Gmp.exportBigNatToAddr bigNat addr# 1#
#endif /* HAVE_GHC_BIGNUM */
bigNatToBuilder :: BigNat -> B.Builder
bigNatToBuilder :: BigNat -> Builder
bigNatToBuilder = BigNat -> Builder
bigNatBuilder
where
bigNatBuilder :: BigNat -> B.Builder
bigNatBuilder :: BigNat -> Builder
bigNatBuilder BigNat
bigNat =
let sizeW :: Word
sizeW = BigNat -> Word
bigNatSizeInBytes BigNat
bigNat
#if MIN_VERSION_bytestring(0,10,12)
bounded :: BoundedPrim BigNat
bounded = forall a.
Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
PI.boundedPrim (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
sizeW) (forall a. Word -> BigNat -> Ptr a -> IO (Ptr a)
dumpBigNat Word
sizeW)
#else
bounded = PI.boudedPrim (fromIntegral sizeW) (dumpBigNat sizeW)
#endif
in forall a. BoundedPrim a -> a -> Builder
P.primBounded BoundedPrim Word
bytesLenMP Word
sizeW forall a. Semigroup a => a -> a -> a
<> forall a. BoundedPrim a -> a -> Builder
P.primBounded BoundedPrim BigNat
bounded BigNat
bigNat
dumpBigNat :: Word -> BigNat -> Ptr a -> IO (Ptr a)
dumpBigNat :: forall a. Word -> BigNat -> Ptr a -> IO (Ptr a)
dumpBigNat (W# Word#
sizeW#) BigNat
bigNat ptr :: Ptr a
ptr@(Ptr Addr#
addr#) = do
(W# Word#
written#) <- BigNat -> Addr# -> IO Word
exportBigNatToAddr BigNat
bigNat Addr#
addr#
let !newPtr :: Ptr b
newPtr = Ptr a
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int# -> Int
I# (Word# -> Int#
word2Int# Word#
written#))
sanity :: Bool
sanity = Int# -> Bool
isTrue# (Word#
sizeW# Word# -> Word# -> Int#
`eqWord#` Word#
written#)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => Bool -> a -> a
assert Bool
sanity forall {b}. Ptr b
newPtr
#else /* OPTIMIZE_GMP */
integerMP :: Integer -> B.Builder
integerMP n
| n >= 0 = P.primBounded header 0xc2 <> integerToBuilder n
| otherwise = P.primBounded header 0xc3 <> integerToBuilder (-1 - n)
integerToBuilder :: Integer -> B.Builder
integerToBuilder n = bytesMP (integerToBytes n)
integerToBytes :: Integer -> S.ByteString
integerToBytes n0
| n0 == 0 = S.pack [0]
| otherwise = S.pack (reverse (go n0))
where
go n | n == 0 = []
| otherwise = narrow n : go (n `shiftR` 8)
narrow :: Integer -> Word8
narrow = fromIntegral
#endif /* OPTIMIZE_GMP */