proto3-wire-1.4.1: A low-level implementation of the Protocol Buffers (version 3) wire format
Safe HaskellSafe-Inferred
LanguageHaskell2010

Proto3.Wire.Reverse.Internal

Description

Implementation details of the Data.ByteString.Reverse module. Breaking changes will be more frequent in this module; use with caution.

Synopsis

Documentation

newtype BuildR Source #

Writes bytes in reverse order, updating the current state.

It is the responsibility of the execution context and buffer management primitives to ensure that the current buffer remains reachable during builder execution, though completed buffers may be copied to new storage at any time. Aside from those primitives, BuildR implementations may ignore that issue.

When combining BuildRs with <> we expect the best performance when associating to the left. For example foldl (<>) mempty, though unless your foldl iteration starts from the right there may still be issues. Consider using vectorBuildR instead of foldMap.

Constructors

BuildR (Addr# -> Int# -> State# RealWorld -> (# Addr#, Int#, State# RealWorld #))

Both the builder arguments and the returned values are:

  1. The starting address of the *used* portion of the current buffer.
  2. The number of *unused* bytes in the current buffer.
  3. The state token (which does not consume any machine registers).

It seems we cannot preserve register allocation between the arguments and the returned components, even by including padding. If GHC were to allocate registers right-to-left (instead of the current left-to-right), and if it made sure to allocate the register that it uses for closure arguments *last* when allocating return registers, then we would stand a chance of not having to move the state components between registers. That way a -> b -> BuildR and BuildR would use the same registers for state components as each other, and a non-inline return from one could be used to call the other without moving state components.

But in many cases register movements combine with increments. Also, we have arranged to put only the most frequently-used state components into registers, which reduces the costs of both moves and of save/reload pairs. For example, our tracking of the total bytes written involves metadata at the start of the current buffer rather than an additional state register.

Instances

Instances details
Monoid BuildR Source # 
Instance details

Defined in Proto3.Wire.Reverse.Internal

Semigroup BuildR Source # 
Instance details

Defined in Proto3.Wire.Reverse.Internal

Show BuildR Source # 
Instance details

Defined in Proto3.Wire.Reverse.Internal

data BuildRState Source #

The current state of execution of a builder is a StablePtr (IORef BuildRState).

Current Buffer Layout:

We devote the first few octets of the current buffer to metadata that does not change very frequently:

  • Addr#: cast to 'StablePtr# (IORef BuildRState)'; indirect acceses to the full builder state, which is used relatively infrequently.
  • Int#: the total number of non-metadata bytes originally available within the current buffer before we started consuming them,
  • plus* the number of bytes actually written to previous buffers. We subtract the current unused figure to get the total bytes written.
  • Double#: suitably-aligned scratch space for serialization of Double and Float values.

Though this choice imposes a small memory overhead in every buffer, it reduces the time and space required to save and restore metadata around the many non-inline calls that typically occur while writing data into the buffer.

Constructors

BuildRState 

Fields

  • currentBuffer :: !(MutableByteArray RealWorld)

    Specifies the current buffer. Note that through this field every StablePtr (IORef BuildRState) keeps one buffer reachable until that stable pointer is explicitly destroyed.

  • sealedBuffers :: ByteString

    Holds the bytes written to previous buffers. We arrange for this field to be in normal form (not just weak head normal form). But to avoid redundant evaluation we do not mark it strict.

appendBuildR :: BuildR -> BuildR -> BuildR Source #

Needed for rewrite rules; normally you would use <>.

foldlRVector :: Vector v a => (b -> a -> b) -> b -> v a -> b Source #

Like foldl but iterates right-to-left, which is often useful when creating reverse builders.

etaBuildR :: (a -> BuildR) -> a -> BuildR Source #

Eta-expands a function that produces a BuildR, so that its input is not evaluated until the builder state is presented.

This odd combinator seems to help performance at times, though it may change behavior on nonterminating values of type a.

runBuildR :: BuildR -> (Int, ByteString) Source #

Like toLazyByteString but also returns the total length of the lazy ByteString, which is computed as a side effect of encoding.

data SealedState Source #

The result of a call to sealBuffer.

Constructors

SealedState 

Fields

  • sealedSB :: ByteString

    All bytes written thus far.

  • totalSB :: !Int

    The total number of bytes written thus far.

  • stateVarSB :: !(IORef BuildRState)

    The builder state variable. This function does NOT modify that variable--it will still refer to the old buffer unless and until you modify it.

  • statePtrSB :: !(StablePtr (IORef BuildRState))

    The stable pointer to the variable referenced by stateVarSB.

  • recycledSB :: Maybe (MutableByteArray RealWorld)

    Returns ownership of the old current buffer to the caller if it is no longer needed to track the already-written bytes.

    If you reuse it within the same builder then there is no need to reset the stable pointer to the state variable, but please be sure to update the "space" metadatum.

sealBuffer Source #

Arguments

:: Ptr Word8

Pointer to the used portion of the current buffer.

-> Int

The number of bytes still unused in the current buffer.

-> IO SealedState 

Takes ownership of the current buffer, but sometimes hands it back for reuse.

If more building is required then please allocate a new current buffer and update the builder state variable accordingly.

(This is a manual wrapper around sealBuffer#.)

readSpace :: Ptr MetaData -> IO Int Source #

writeSpace :: Ptr MetaData -> Int -> IO () Source #

withUnused :: (Int -> BuildR) -> BuildR Source #

First reads the number of unused bytes in the current buffer.

withTotal :: (Int -> BuildR) -> BuildR Source #

First reads the number of bytes previously written.

readTotal :: Ptr Word8 -> Int -> IO Int Source #

The arguments are the same as the BuildR arguments.

withLengthOf :: (Int -> BuildR) -> BuildR -> BuildR Source #

Executes the right builder, measuring how many bytes it writes, then provides that figure to the left builder.

withLengthOf# :: (Int# -> BuildR) -> BuildR -> BuildR Source #

Executes the right builder, measuring how many bytes it writes, then provides that figure to the left builder.

reallocate :: Int -> BuildR Source #

Seals the current buffer and creates a new one with at least the given number of bytes.

prependChunk :: ByteString -> BuildR Source #

Prepends a ByteString to the output.

NOTE: This is a relatively heavyweight operation. For small strings it may be faster to copy them to the current buffer.

newtype ReverseChunks Source #

Like ByteString, but with the chunks in reverse order, even though the bytes within each chunk are in forward order.

Constructors

ReverseChunks 

prependReverseChunks :: ReverseChunks -> BuildR Source #

Equivalent to the following, but faster:

foldMap prependChunk . reverse . getReverseChunks

NOTE: This is a relatively heavyweight operation. For small strings it may be faster to copy them to the current buffer.

ensure :: Int -> BuildR -> BuildR Source #

Ensures that the current buffer has at least the given number of bytes before executing the given builder.

unsafeConsume :: Int -> (Ptr Word8 -> IO ()) -> BuildR Source #

ASSUMES that the specified number of bytes is both nonnegative and less than or equal to the number of unused bytes in the current buffer, consumes that number of unused bytes, and provides their starting address.

floatToWord32 :: Ptr Word8 -> Int -> Float -> IO Word32 Source #

Given the builder inputs and a Float, converts that number to its bit pattern in native byte order.

doubleToWord64 :: Ptr Word8 -> Int -> Double -> IO Word64 Source #

Given the builder inputs and a Double, converts that number to its bit pattern in native byte order.