{-# language BangPatterns #-}
{-# language DuplicateRecordFields #-}
{-# language LambdaCase #-}
{-# language MagicHash #-}
{-# language RankNTypes #-}
{-# language ScopedTypeVariables #-}
{-# language UnboxedTuples #-}

module Data.Bytes.Builder.Unsafe
  ( -- * Types
    Builder(..)
  , BuilderState(..)
  , Commits(..)
    -- * Execution
  , pasteST
  , pasteIO
    -- * Construction
  , fromEffect
    -- * Builder State
  , newBuilderState
  , closeBuilderState
    -- * Finalization
  , reverseCommitsOntoChunks
  , commitsOntoChunks
  , copyReverseCommits
  , addCommitsLength
    -- * Commit Distance
  , commitDistance
  , commitDistance1
    -- * Safe Functions
    -- | These functions are actually completely safe, but they are defined
    -- here because they are used by typeclass instances. Import them from
    -- @Data.Bytes.Builder@ instead.
  , stringUtf8
  , cstring
  ) where

import Control.Monad.Primitive (primitive_)
import Data.Bytes.Chunks (Chunks(ChunksCons))
import Data.Bytes.Types (Bytes(Bytes))
import Data.Primitive (MutableByteArray(..),ByteArray(..))
import Foreign.C.String (CString)
import GHC.Base (unpackCString#,unpackCStringUtf8#)
import GHC.Exts ((-#),(+#),(>#),(>=#))
import GHC.Exts (Addr#,ByteArray#,MutableByteArray#,Int(I#),Ptr(Ptr))
import GHC.Exts (RealWorld,IsString,Int#,State#)
import GHC.ST (ST(ST))
import GHC.IO (stToIO)

import qualified Compat as C

import qualified Data.Bytes.Builder.Bounded as Bounded
import qualified Data.Bytes.Builder.Bounded.Unsafe as UnsafeBounded
import qualified Data.Primitive as PM
import qualified GHC.Exts as Exts

-- | An unmaterialized sequence of bytes that may be pasted
-- into a mutable byte array.
newtype Builder
  = Builder (forall s.
      MutableByteArray# s ->   -- buffer we are currently writing to
      Int# ->   -- offset into the current buffer
      Int# ->   -- number of bytes remaining in the current buffer
      Commits s ->   -- buffers and immutable byte slices that we have already committed
      State# s ->
      (# State# s, MutableByteArray# s, Int#, Int#, Commits s #) -- all the same things
    )

-- | A list of committed chunks along with the chunk currently being
-- written to. This is kind of like a non-empty variant of 'Commmits'
-- but with the additional invariant that the head chunk is a mutable
-- byte array.
data BuilderState s = BuilderState
  (MutableByteArray# s) -- buffer we are currently writing to
  Int# -- offset into the current buffer
  Int# -- number of bytes remaining in the current buffer
  !(Commits s) -- buffers and immutable byte slices that are already committed

-- | Create an empty 'BuilderState' with a buffer of the given size.
newBuilderState :: Int -> ST s (BuilderState s)
{-# inline newBuilderState #-}
newBuilderState :: Int -> ST s (BuilderState s)
newBuilderState n :: Int
n@(I# Int#
n# ) = do
  MutableByteArray MutableByteArray# s
buf <- Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newByteArray Int
n
  BuilderState s -> ST s (BuilderState s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MutableByteArray# s -> Int# -> Int# -> Commits s -> BuilderState s
forall s.
MutableByteArray# s -> Int# -> Int# -> Commits s -> BuilderState s
BuilderState MutableByteArray# s
buf Int#
0# Int#
n# Commits s
forall s. Commits s
Initial)

-- | Push the active chunk onto the top of the commits.
-- The @BuilderState@ argument must not be reused after being passed
-- to this function. That is, its use must be affine.
closeBuilderState :: BuilderState s -> Commits s
closeBuilderState :: BuilderState s -> Commits s
closeBuilderState (BuilderState MutableByteArray# s
dst Int#
off Int#
_ Commits s
cmts) = MutableByteArray# s -> Int# -> Commits s -> Commits s
forall s. MutableByteArray# s -> Int# -> Commits s -> Commits s
Mutable MutableByteArray# s
dst Int#
off Commits s
cmts

-- | Run a builder, performing an in-place update on the state.
-- The @BuilderState@ argument must not be reused after being passed
-- to this function. That is, its use must be affine.
pasteST :: Builder -> BuilderState s -> ST s (BuilderState s)
{-# inline pasteST #-}
pasteST :: Builder -> BuilderState s -> ST s (BuilderState s)
pasteST (Builder forall s.
MutableByteArray# s
-> Int#
-> Int#
-> Commits s
-> State# s
-> (# State# s, MutableByteArray# s, Int#, Int#, Commits s #)
f) (BuilderState MutableByteArray# s
buf Int#
off Int#
len Commits s
cmts) = STRep s (BuilderState s) -> ST s (BuilderState s)
forall s a. STRep s a -> ST s a
ST (STRep s (BuilderState s) -> ST s (BuilderState s))
-> STRep s (BuilderState s) -> ST s (BuilderState s)
forall a b. (a -> b) -> a -> b
$ \State# s
s0 ->
  case MutableByteArray# s
-> Int#
-> Int#
-> Commits s
-> State# s
-> (# State# s, MutableByteArray# s, Int#, Int#, Commits s #)
forall s.
MutableByteArray# s
-> Int#
-> Int#
-> Commits s
-> State# s
-> (# State# s, MutableByteArray# s, Int#, Int#, Commits s #)
f MutableByteArray# s
buf Int#
off Int#
len Commits s
cmts State# s
s0 of
    (# State# s
s1, MutableByteArray# s
buf1, Int#
off1, Int#
len1, Commits s
cmts1 #) ->
      (# State# s
s1, MutableByteArray# s -> Int# -> Int# -> Commits s -> BuilderState s
forall s.
MutableByteArray# s -> Int# -> Int# -> Commits s -> BuilderState s
BuilderState MutableByteArray# s
buf1 Int#
off1 Int#
len1 Commits s
cmts1 #)

-- | Variant of 'pasteST' that runs in 'IO'.
pasteIO :: Builder -> BuilderState RealWorld -> IO (BuilderState RealWorld)
{-# inline pasteIO #-}
pasteIO :: Builder -> BuilderState RealWorld -> IO (BuilderState RealWorld)
pasteIO Builder
b BuilderState RealWorld
st = ST RealWorld (BuilderState RealWorld)
-> IO (BuilderState RealWorld)
forall a. ST RealWorld a -> IO a
stToIO (Builder
-> BuilderState RealWorld -> ST RealWorld (BuilderState RealWorld)
forall s. Builder -> BuilderState s -> ST s (BuilderState s)
pasteST Builder
b BuilderState RealWorld
st)

instance IsString Builder where
  {-# inline fromString #-}
  fromString :: String -> Builder
fromString = String -> Builder
stringUtf8

instance Semigroup Builder where
  {-# inline (<>) #-}
  Builder forall s.
MutableByteArray# s
-> Int#
-> Int#
-> Commits s
-> State# s
-> (# State# s, MutableByteArray# s, Int#, Int#, Commits s #)
f <> :: Builder -> Builder -> Builder
<> Builder forall s.
MutableByteArray# s
-> Int#
-> Int#
-> Commits s
-> State# s
-> (# State# s, MutableByteArray# s, Int#, Int#, Commits s #)
g = (forall s.
 MutableByteArray# s
 -> Int#
 -> Int#
 -> Commits s
 -> State# s
 -> (# State# s, MutableByteArray# s, Int#, Int#, Commits s #))
-> Builder
Builder ((forall s.
  MutableByteArray# s
  -> Int#
  -> Int#
  -> Commits s
  -> State# s
  -> (# State# s, MutableByteArray# s, Int#, Int#, Commits s #))
 -> Builder)
-> (forall s.
    MutableByteArray# s
    -> Int#
    -> Int#
    -> Commits s
    -> State# s
    -> (# State# s, MutableByteArray# s, Int#, Int#, Commits s #))
-> Builder
forall a b. (a -> b) -> a -> b
$ \MutableByteArray# s
buf0 Int#
off0 Int#
len0 Commits s
cs0 State# s
s0 -> case MutableByteArray# s
-> Int#
-> Int#
-> Commits s
-> State# s
-> (# State# s, MutableByteArray# s, Int#, Int#, Commits s #)
forall s.
MutableByteArray# s
-> Int#
-> Int#
-> Commits s
-> State# s
-> (# State# s, MutableByteArray# s, Int#, Int#, Commits s #)
f MutableByteArray# s
buf0 Int#
off0 Int#
len0 Commits s
cs0 State# s
s0 of
    (# State# s
s1, MutableByteArray# s
buf1, Int#
off1, Int#
len1, Commits s
cs1 #) -> MutableByteArray# s
-> Int#
-> Int#
-> Commits s
-> State# s
-> (# State# s, MutableByteArray# s, Int#, Int#, Commits s #)
forall s.
MutableByteArray# s
-> Int#
-> Int#
-> Commits s
-> State# s
-> (# State# s, MutableByteArray# s, Int#, Int#, Commits s #)
g MutableByteArray# s
buf1 Int#
off1 Int#
len1 Commits s
cs1 State# s
s1

instance Monoid Builder where
  {-# inline mempty #-}
  mempty :: Builder
mempty = (forall s.
 MutableByteArray# s
 -> Int#
 -> Int#
 -> Commits s
 -> State# s
 -> (# State# s, MutableByteArray# s, Int#, Int#, Commits s #))
-> Builder
Builder ((forall s.
  MutableByteArray# s
  -> Int#
  -> Int#
  -> Commits s
  -> State# s
  -> (# State# s, MutableByteArray# s, Int#, Int#, Commits s #))
 -> Builder)
-> (forall s.
    MutableByteArray# s
    -> Int#
    -> Int#
    -> Commits s
    -> State# s
    -> (# State# s, MutableByteArray# s, Int#, Int#, Commits s #))
-> Builder
forall a b. (a -> b) -> a -> b
$ \MutableByteArray# s
buf0 Int#
off0 Int#
len0 Commits s
cs0 State# s
s0 -> (# State# s
s0, MutableByteArray# s
buf0, Int#
off0, Int#
len0, Commits s
cs0 #)

data Commits s
  = Mutable
      (MutableByteArray# s)
      -- ^ Mutable buffer, start index implicitly zero
      Int# -- ^ Length (may be smaller than actual length)
      !(Commits s)
  | Immutable
      ByteArray# -- ^ Immutable chunk
      Int# -- ^ Offset into chunk, not necessarily zero
      Int# -- ^ Length (may be smaller than actual length)
      !(Commits s)
  | Initial

-- | Add the total number of bytes in the commits to first
-- argument.
addCommitsLength :: Int -> Commits s -> Int
addCommitsLength :: Int -> Commits s -> Int
addCommitsLength !Int
acc Commits s
Initial = Int
acc
addCommitsLength !Int
acc (Immutable ByteArray#
_ Int#
_ Int#
x Commits s
cs) = Int -> Commits s -> Int
forall s. Int -> Commits s -> Int
addCommitsLength (Int
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int# -> Int
I# Int#
x) Commits s
cs
addCommitsLength !Int
acc (Mutable MutableByteArray# s
_ Int#
x Commits s
cs) = Int -> Commits s -> Int
forall s. Int -> Commits s -> Int
addCommitsLength (Int
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int# -> Int
I# Int#
x) Commits s
cs

-- | Cons the chunks from a list of @Commits@ onto an initial
-- @Chunks@ list (this argument is often @ChunksNil@). This reverses
-- the order of the chunks, which is desirable since builders assemble
-- @Commits@ with the chunks backwards. This performs an in-place shrink
-- and freezes any mutable byte arrays it encounters. Consequently,
-- these must not be reused.
reverseCommitsOntoChunks :: Chunks -> Commits s -> ST s Chunks
reverseCommitsOntoChunks :: Chunks -> Commits s -> ST s Chunks
reverseCommitsOntoChunks !Chunks
xs Commits s
Initial = Chunks -> ST s Chunks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Chunks
xs
reverseCommitsOntoChunks !Chunks
xs (Immutable ByteArray#
arr Int#
off Int#
len Commits s
cs) =
  Chunks -> Commits s -> ST s Chunks
forall s. Chunks -> Commits s -> ST s Chunks
reverseCommitsOntoChunks (Bytes -> Chunks -> Chunks
ChunksCons (ByteArray -> Int -> Int -> Bytes
Bytes (ByteArray# -> ByteArray
ByteArray ByteArray#
arr) (Int# -> Int
I# Int#
off) (Int# -> Int
I# Int#
len)) Chunks
xs) Commits s
cs
reverseCommitsOntoChunks !Chunks
xs (Mutable MutableByteArray# s
buf Int#
len Commits s
cs) = case Int#
len of
  -- Skip over empty byte arrays.
  Int#
0# -> Chunks -> Commits s -> ST s Chunks
forall s. Chunks -> Commits s -> ST s Chunks
reverseCommitsOntoChunks Chunks
xs Commits s
cs
  Int#
_ -> do
    MutableByteArray s -> Int -> ST s ()
forall s. MutableByteArray s -> Int -> ST s ()
shrinkMutableByteArray (MutableByteArray# s -> MutableByteArray s
forall s. MutableByteArray# s -> MutableByteArray s
MutableByteArray MutableByteArray# s
buf) (Int# -> Int
I# Int#
len)
    ByteArray
arr <- MutableByteArray (PrimState (ST s)) -> ST s ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
PM.unsafeFreezeByteArray (MutableByteArray# s -> MutableByteArray s
forall s. MutableByteArray# s -> MutableByteArray s
MutableByteArray MutableByteArray# s
buf)
    Chunks -> Commits s -> ST s Chunks
forall s. Chunks -> Commits s -> ST s Chunks
reverseCommitsOntoChunks (Bytes -> Chunks -> Chunks
ChunksCons (ByteArray -> Int -> Int -> Bytes
Bytes ByteArray
arr Int
0 (Int# -> Int
I# Int#
len)) Chunks
xs) Commits s
cs

-- | Variant of 'reverseCommitsOntoChunks' that does not reverse
-- the order of the commits. Since commits are built backwards by
-- consing, this means that the chunks appended to the front will
-- be backwards. Within each chunk, however, the bytes will be in
-- the correct order.
--
-- Unlike 'reverseCommitsOntoChunks', this function is not tail
-- recursive.
commitsOntoChunks :: Chunks -> Commits s -> ST s Chunks
commitsOntoChunks :: Chunks -> Commits s -> ST s Chunks
commitsOntoChunks !Chunks
xs0 Commits s
cs0 = Commits s -> ST s Chunks
forall s. Commits s -> ST s Chunks
go Commits s
cs0
  where
  go :: Commits s -> ST s Chunks
go Commits s
Initial = Chunks -> ST s Chunks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Chunks
xs0
  go (Immutable ByteArray#
arr Int#
off Int#
len Commits s
cs) = do
    Chunks
xs <- Commits s -> ST s Chunks
go Commits s
cs
    Chunks -> ST s Chunks
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Chunks -> ST s Chunks) -> Chunks -> ST s Chunks
forall a b. (a -> b) -> a -> b
$! Bytes -> Chunks -> Chunks
ChunksCons (ByteArray -> Int -> Int -> Bytes
Bytes (ByteArray# -> ByteArray
ByteArray ByteArray#
arr) (Int# -> Int
I# Int#
off) (Int# -> Int
I# Int#
len)) Chunks
xs
  go (Mutable MutableByteArray# s
buf Int#
len Commits s
cs) = case Int#
len of
    -- Skip over empty byte arrays.
    Int#
0# -> Commits s -> ST s Chunks
go Commits s
cs
    Int#
_ -> do
      MutableByteArray s -> Int -> ST s ()
forall s. MutableByteArray s -> Int -> ST s ()
shrinkMutableByteArray (MutableByteArray# s -> MutableByteArray s
forall s. MutableByteArray# s -> MutableByteArray s
MutableByteArray MutableByteArray# s
buf) (Int# -> Int
I# Int#
len)
      ByteArray
arr <- MutableByteArray (PrimState (ST s)) -> ST s ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
PM.unsafeFreezeByteArray (MutableByteArray# s -> MutableByteArray s
forall s. MutableByteArray# s -> MutableByteArray s
MutableByteArray MutableByteArray# s
buf)
      Chunks
xs <- Commits s -> ST s Chunks
go Commits s
cs
      Chunks -> ST s Chunks
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Chunks -> ST s Chunks) -> Chunks -> ST s Chunks
forall a b. (a -> b) -> a -> b
$! Bytes -> Chunks -> Chunks
ChunksCons (ByteArray -> Int -> Int -> Bytes
Bytes ByteArray
arr Int
0 (Int# -> Int
I# Int#
len)) Chunks
xs

-- | Copy the contents of the chunks into a mutable array, reversing
-- the order of the chunks.
-- Precondition: The destination must have enough space to house the
-- contents. This is not checked.
copyReverseCommits ::
     MutableByteArray s -- ^ Destination
  -> Int -- ^ Destination range successor
  -> Commits s -- ^ Source
  -> ST s Int
{-# inline copyReverseCommits #-}
copyReverseCommits :: MutableByteArray s -> Int -> Commits s -> ST s Int
copyReverseCommits (MutableByteArray MutableByteArray# s
dst) (I# Int#
off) Commits s
cs = STRep s Int -> ST s Int
forall s a. STRep s a -> ST s a
ST
  (\State# s
s0 -> case MutableByteArray# s
-> Int# -> Commits s -> State# s -> (# State# s, Int# #)
forall s.
MutableByteArray# s
-> Int# -> Commits s -> State# s -> (# State# s, Int# #)
copyReverseCommits# MutableByteArray# s
dst Int#
off Commits s
cs State# s
s0 of
    (# State# s
s1, Int#
nextOff #) -> (# State# s
s1, Int# -> Int
I# Int#
nextOff #)
  )

copyReverseCommits# ::
     MutableByteArray# s
  -> Int#
  -> Commits s
  -> State# s
  -> (# State# s, Int# #)
copyReverseCommits# :: MutableByteArray# s
-> Int# -> Commits s -> State# s -> (# State# s, Int# #)
copyReverseCommits# MutableByteArray# s
_ Int#
off Commits s
Initial State# s
s0 = (# State# s
s0, Int#
off #)
copyReverseCommits# MutableByteArray# s
marr Int#
prevOff (Mutable MutableByteArray# s
arr Int#
sz Commits s
cs) State# s
s0 =
  let !off :: Int#
off = Int#
prevOff Int# -> Int# -> Int#
-# Int#
sz in
  case MutableByteArray# s
-> Int#
-> MutableByteArray# s
-> Int#
-> Int#
-> State# s
-> State# s
forall d.
MutableByteArray# d
-> Int#
-> MutableByteArray# d
-> Int#
-> Int#
-> State# d
-> State# d
Exts.copyMutableByteArray# MutableByteArray# s
arr Int#
0# MutableByteArray# s
marr Int#
off Int#
sz State# s
s0 of
    State# s
s1 -> MutableByteArray# s
-> Int# -> Commits s -> State# s -> (# State# s, Int# #)
forall s.
MutableByteArray# s
-> Int# -> Commits s -> State# s -> (# State# s, Int# #)
copyReverseCommits# MutableByteArray# s
marr Int#
off Commits s
cs State# s
s1
copyReverseCommits# MutableByteArray# s
marr Int#
prevOff (Immutable ByteArray#
arr Int#
soff Int#
sz Commits s
cs) State# s
s0 =
  let !off :: Int#
off = Int#
prevOff Int# -> Int# -> Int#
-# Int#
sz in
  case ByteArray#
-> Int#
-> MutableByteArray# s
-> Int#
-> Int#
-> State# s
-> State# s
forall d.
ByteArray#
-> Int#
-> MutableByteArray# d
-> Int#
-> Int#
-> State# d
-> State# d
Exts.copyByteArray# ByteArray#
arr Int#
soff MutableByteArray# s
marr Int#
off Int#
sz State# s
s0 of
    State# s
s1 -> MutableByteArray# s
-> Int# -> Commits s -> State# s -> (# State# s, Int# #)
forall s.
MutableByteArray# s
-> Int# -> Commits s -> State# s -> (# State# s, Int# #)
copyReverseCommits# MutableByteArray# s
marr Int#
off Commits s
cs State# s
s1

-- | Create a builder from a cons-list of 'Char'. These
-- must be UTF-8 encoded.
stringUtf8 :: String -> Builder
{-# inline stringUtf8 #-}
stringUtf8 :: String -> Builder
stringUtf8 String
cs = (forall s.
 MutableByteArray# s
 -> Int#
 -> Int#
 -> Commits s
 -> State# s
 -> (# State# s, MutableByteArray# s, Int#, Int#, Commits s #))
-> Builder
Builder (String
-> MutableByteArray# s
-> Int#
-> Int#
-> Commits s
-> State# s
-> (# State# s, MutableByteArray# s, Int#, Int#, Commits s #)
forall s.
String
-> MutableByteArray# s
-> Int#
-> Int#
-> Commits s
-> State# s
-> (# State# s, MutableByteArray# s, Int#, Int#, Commits s #)
goString String
cs)

-- | Create a builder from a @NUL@-terminated 'CString'. This ignores any
-- textual encoding, copying bytes until @NUL@ is reached.
cstring :: CString -> Builder
{-# inline cstring #-}
cstring :: CString -> Builder
cstring (Ptr Addr#
cs) = (forall s.
 MutableByteArray# s
 -> Int#
 -> Int#
 -> Commits s
 -> State# s
 -> (# State# s, MutableByteArray# s, Int#, Int#, Commits s #))
-> Builder
Builder (Addr#
-> MutableByteArray# s
-> Int#
-> Int#
-> Commits s
-> State# s
-> (# State# s, MutableByteArray# s, Int#, Int#, Commits s #)
forall s.
Addr#
-> MutableByteArray# s
-> Int#
-> Int#
-> Commits s
-> State# s
-> (# State# s, MutableByteArray# s, Int#, Int#, Commits s #)
goCString Addr#
cs)

goString :: String
  -> MutableByteArray# s -> Int# -> Int# -> Commits s
  -> State# s -> (# State# s, MutableByteArray# s, Int#, Int#, Commits s #)
{-# noinline goString #-}
goString :: String
-> MutableByteArray# s
-> Int#
-> Int#
-> Commits s
-> State# s
-> (# State# s, MutableByteArray# s, Int#, Int#, Commits s #)
goString [] MutableByteArray# s
buf0 Int#
off0 Int#
len0 Commits s
cs0 State# s
s0 = (# State# s
s0, MutableByteArray# s
buf0, Int#
off0, Int#
len0, Commits s
cs0 #)
goString (Char
c : String
cs) MutableByteArray# s
buf0 Int#
off0 Int#
len0 Commits s
cs0 State# s
s0 = case Int#
len0 Int# -> Int# -> Int#
># Int#
3# of
  Int#
1# -> case ST s Int -> State# s -> (# State# s, Int #)
forall s a. ST s a -> State# s -> (# State# s, a #)
unST (Builder 4 -> MutableByteArray s -> Int -> ST s Int
forall (n :: Nat) s.
Builder n -> MutableByteArray s -> Int -> ST s Int
UnsafeBounded.pasteST (Char -> Builder 4
Bounded.char Char
c) (MutableByteArray# s -> MutableByteArray s
forall s. MutableByteArray# s -> MutableByteArray s
MutableByteArray MutableByteArray# s
buf0) (Int# -> Int
I# Int#
off0)) State# s
s0 of
    (# State# s
s1, I# Int#
off1 #) -> String
-> MutableByteArray# s
-> Int#
-> Int#
-> Commits s
-> State# s
-> (# State# s, MutableByteArray# s, Int#, Int#, Commits s #)
forall s.
String
-> MutableByteArray# s
-> Int#
-> Int#
-> Commits s
-> State# s
-> (# State# s, MutableByteArray# s, Int#, Int#, Commits s #)
goString String
cs MutableByteArray# s
buf0 Int#
off1 (Int#
len0 Int# -> Int# -> Int#
-# (Int#
off1 Int# -> Int# -> Int#
-# Int#
off0)) Commits s
cs0 State# s
s1
  Int#
_ -> case Int# -> State# s -> (# State# s, MutableByteArray# s #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
Exts.newByteArray# Int#
4080# State# s
s0 of
    (# State# s
s1, MutableByteArray# s
buf1 #) -> case ST s Int -> State# s -> (# State# s, Int #)
forall s a. ST s a -> State# s -> (# State# s, a #)
unST (Builder 4 -> MutableByteArray s -> Int -> ST s Int
forall (n :: Nat) s.
Builder n -> MutableByteArray s -> Int -> ST s Int
UnsafeBounded.pasteST (Char -> Builder 4
Bounded.char Char
c) (MutableByteArray# s -> MutableByteArray s
forall s. MutableByteArray# s -> MutableByteArray s
MutableByteArray MutableByteArray# s
buf1) Int
0) State# s
s1 of
      (# State# s
s2, I# Int#
off1 #) -> String
-> MutableByteArray# s
-> Int#
-> Int#
-> Commits s
-> State# s
-> (# State# s, MutableByteArray# s, Int#, Int#, Commits s #)
forall s.
String
-> MutableByteArray# s
-> Int#
-> Int#
-> Commits s
-> State# s
-> (# State# s, MutableByteArray# s, Int#, Int#, Commits s #)
goString String
cs MutableByteArray# s
buf1 Int#
off1 (Int#
4080# Int# -> Int# -> Int#
-# Int#
off1) (MutableByteArray# s -> Int# -> Commits s -> Commits s
forall s. MutableByteArray# s -> Int# -> Commits s -> Commits s
Mutable MutableByteArray# s
buf0 Int#
off0 Commits s
cs0) State# s
s2

-- We have to have a rule for both unpackCString# and unpackCStringUtf8#
-- since GHC uses a different function based on whether or not non-ASCII
-- codepoints are used in the string.
-- TODO: The UTF-8 variant of this rule is unsound because GHC actually
-- used Modified UTF-8.
{-# RULES
"Builder stringUtf8/cstring" forall s a b c d e.
  goString (unpackCString# s) a b c d e = goCString s a b c d e
"Builder stringUtf8/cstring-utf8" forall s a b c d e.
  goString (unpackCStringUtf8# s) a b c d e = goCString s a b c d e
#-}

goCString :: Addr# -> MutableByteArray# s -> Int# -> Int# -> Commits s
  -> State# s -> (# State# s, MutableByteArray# s, Int#, Int#, Commits s #)
goCString :: Addr#
-> MutableByteArray# s
-> Int#
-> Int#
-> Commits s
-> State# s
-> (# State# s, MutableByteArray# s, Int#, Int#, Commits s #)
goCString Addr#
addr MutableByteArray# s
buf0 Int#
off0 Int#
len0 Commits s
cs0 State# s
s0 = case Word# -> Word#
C.word8ToWord# (Addr# -> Int# -> Word#
Exts.indexWord8OffAddr# Addr#
addr Int#
0#) of
  Word#
0## -> (# State# s
s0, MutableByteArray# s
buf0, Int#
off0, Int#
len0, Commits s
cs0 #)
  Word#
w -> case Int#
len0 of
    Int#
0# -> case Int# -> State# s -> (# State# s, MutableByteArray# s #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
Exts.newByteArray# Int#
4080# State# s
s0 of
      (# State# s
s1, MutableByteArray# s
buf1 #) -> case MutableByteArray# s -> Int# -> Word# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Word# -> State# d -> State# d
Exts.writeWord8Array# MutableByteArray# s
buf1 Int#
0# (Word# -> Word#
C.wordToWord8# Word#
w) State# s
s1 of
        State# s
s2 -> Addr#
-> MutableByteArray# s
-> Int#
-> Int#
-> Commits s
-> State# s
-> (# State# s, MutableByteArray# s, Int#, Int#, Commits s #)
forall s.
Addr#
-> MutableByteArray# s
-> Int#
-> Int#
-> Commits s
-> State# s
-> (# State# s, MutableByteArray# s, Int#, Int#, Commits s #)
goCString
          (Addr# -> Int# -> Addr#
Exts.plusAddr# Addr#
addr Int#
1# ) MutableByteArray# s
buf1 Int#
1# (Int#
4080# Int# -> Int# -> Int#
-# Int#
1# )
          (MutableByteArray# s -> Int# -> Commits s -> Commits s
forall s. MutableByteArray# s -> Int# -> Commits s -> Commits s
Mutable MutableByteArray# s
buf0 Int#
off0 Commits s
cs0)
          State# s
s2
    Int#
_ -> case MutableByteArray# s -> Int# -> Word# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Word# -> State# d -> State# d
Exts.writeWord8Array# MutableByteArray# s
buf0 Int#
off0 (Word# -> Word#
C.wordToWord8# Word#
w) State# s
s0 of
      State# s
s1 -> Addr#
-> MutableByteArray# s
-> Int#
-> Int#
-> Commits s
-> State# s
-> (# State# s, MutableByteArray# s, Int#, Int#, Commits s #)
forall s.
Addr#
-> MutableByteArray# s
-> Int#
-> Int#
-> Commits s
-> State# s
-> (# State# s, MutableByteArray# s, Int#, Int#, Commits s #)
goCString (Addr# -> Int# -> Addr#
Exts.plusAddr# Addr#
addr Int#
1# ) MutableByteArray# s
buf0 (Int#
off0 Int# -> Int# -> Int#
+# Int#
1# ) (Int#
len0 Int# -> Int# -> Int#
-# Int#
1# ) Commits s
cs0 State# s
s1

fromEffect ::
     Int -- ^ Maximum number of bytes the paste function needs
  -> (forall s. MutableByteArray s -> Int -> ST s Int)
     -- ^ Paste function. Takes a byte array and an offset and returns
     -- the new offset and having pasted into the buffer.
  -> Builder
{-# inline fromEffect #-}
fromEffect :: Int -> (forall s. MutableByteArray s -> Int -> ST s Int) -> Builder
fromEffect (I# Int#
req) forall s. MutableByteArray s -> Int -> ST s Int
f = (forall s.
 MutableByteArray# s
 -> Int#
 -> Int#
 -> Commits s
 -> State# s
 -> (# State# s, MutableByteArray# s, Int#, Int#, Commits s #))
-> Builder
Builder ((forall s.
  MutableByteArray# s
  -> Int#
  -> Int#
  -> Commits s
  -> State# s
  -> (# State# s, MutableByteArray# s, Int#, Int#, Commits s #))
 -> Builder)
-> (forall s.
    MutableByteArray# s
    -> Int#
    -> Int#
    -> Commits s
    -> State# s
    -> (# State# s, MutableByteArray# s, Int#, Int#, Commits s #))
-> Builder
forall a b. (a -> b) -> a -> b
$ \MutableByteArray# s
buf0 Int#
off0 Int#
len0 Commits s
cs0 State# s
s0 ->
  let !(# State# s
s1, MutableByteArray# s
buf1, Int#
off1, Int#
len1, Commits s
cs1 #) = case Int#
len0 Int# -> Int# -> Int#
>=# Int#
req of
        Int#
1# -> (# State# s
s0, MutableByteArray# s
buf0, Int#
off0, Int#
len0, Commits s
cs0 #)
        Int#
_ -> let !(I# Int#
lenX) = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
4080 (Int# -> Int
I# Int#
req) in
          case Int# -> State# s -> (# State# s, MutableByteArray# s #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
Exts.newByteArray# Int#
lenX State# s
s0 of
            (# State# s
sX, MutableByteArray# s
bufX #) ->
              (# State# s
sX, MutableByteArray# s
bufX, Int#
0#, Int#
lenX, MutableByteArray# s -> Int# -> Commits s -> Commits s
forall s. MutableByteArray# s -> Int# -> Commits s -> Commits s
Mutable MutableByteArray# s
buf0 Int#
off0 Commits s
cs0 #)
   in case ST s Int -> State# s -> (# State# s, Int #)
forall s a. ST s a -> State# s -> (# State# s, a #)
unST (MutableByteArray s -> Int -> ST s Int
forall s. MutableByteArray s -> Int -> ST s Int
f (MutableByteArray# s -> MutableByteArray s
forall s. MutableByteArray# s -> MutableByteArray s
MutableByteArray MutableByteArray# s
buf1) (Int# -> Int
I# Int#
off1)) State# s
s1 of
        (# State# s
s2, I# Int#
off2 #) -> (# State# s
s2, MutableByteArray# s
buf1, Int#
off2, Int#
len1 Int# -> Int# -> Int#
-# (Int#
off2 Int# -> Int# -> Int#
-# Int#
off1), Commits s
cs1 #)

unST :: ST s a -> State# s -> (# State# s, a #)
unST :: ST s a -> State# s -> (# State# s, a #)
unST (ST State# s -> (# State# s, a #)
f) = State# s -> (# State# s, a #)
f

shrinkMutableByteArray :: MutableByteArray s -> Int -> ST s ()
shrinkMutableByteArray :: MutableByteArray s -> Int -> ST s ()
shrinkMutableByteArray (MutableByteArray MutableByteArray# s
arr) (I# Int#
sz) =
  (State# (PrimState (ST s)) -> State# (PrimState (ST s))) -> ST s ()
forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ (MutableByteArray# s -> Int# -> State# s -> State# s
forall d. MutableByteArray# d -> Int# -> State# d -> State# d
Exts.shrinkMutableByteArray# MutableByteArray# s
arr Int#
sz)

-- | Variant of commitDistance where you get to supply a
-- head of the commit list that has not yet been committed.
commitDistance1 ::
     MutableByteArray# s -- target
  -> Int# -- offset into target
  -> MutableByteArray# s -- head of array
  -> Int# -- offset into head of array
  -> Commits s
  -> Int#
commitDistance1 :: MutableByteArray# s
-> Int# -> MutableByteArray# s -> Int# -> Commits s -> Int#
commitDistance1 MutableByteArray# s
target Int#
offTarget MutableByteArray# s
buf0 Int#
offBuf Commits s
cs =
  case MutableByteArray# s -> MutableByteArray# s -> Int#
forall d. MutableByteArray# d -> MutableByteArray# d -> Int#
Exts.sameMutableByteArray# MutableByteArray# s
target MutableByteArray# s
buf0 of
    Int#
1# -> Int#
offBuf Int# -> Int# -> Int#
-# Int#
offTarget
    Int#
_ -> MutableByteArray# s -> Int# -> Commits s -> Int#
forall s. MutableByteArray# s -> Int# -> Commits s -> Int#
commitDistance MutableByteArray# s
target Int#
offBuf Commits s
cs Int# -> Int# -> Int#
-# Int#
offTarget

-- | Compute the number of bytes between the last byte and the offset
-- specified in a chunk. Precondition: the chunk must exist in the
-- list of committed chunks. This relies on mutable byte arrays having
-- identity (e.g. it uses @sameMutableByteArray#@).
commitDistance :: MutableByteArray# s -> Int# -> Commits s -> Int#
commitDistance :: MutableByteArray# s -> Int# -> Commits s -> Int#
commitDistance !MutableByteArray# s
_ !Int#
_ Commits s
Initial = String -> Int#
forall a. String -> a
errorWithoutStackTrace String
"chunkDistance: chunk not found"
commitDistance MutableByteArray# s
target !Int#
n (Immutable ByteArray#
_ Int#
_ Int#
len Commits s
cs) =
  MutableByteArray# s -> Int# -> Commits s -> Int#
forall s. MutableByteArray# s -> Int# -> Commits s -> Int#
commitDistance MutableByteArray# s
target (Int#
n Int# -> Int# -> Int#
+# Int#
len) Commits s
cs
commitDistance MutableByteArray# s
target !Int#
n (Mutable MutableByteArray# s
buf Int#
len Commits s
cs) =
  case MutableByteArray# s -> MutableByteArray# s -> Int#
forall d. MutableByteArray# d -> MutableByteArray# d -> Int#
Exts.sameMutableByteArray# MutableByteArray# s
target MutableByteArray# s
buf of
    Int#
1# -> Int#
n Int# -> Int# -> Int#
+# Int#
len
    Int#
_ -> MutableByteArray# s -> Int# -> Commits s -> Int#
forall s. MutableByteArray# s -> Int# -> Commits s -> Int#
commitDistance MutableByteArray# s
target (Int#
n Int# -> Int# -> Int#
+# Int#
len) Commits s
cs