module Data.Text.Builder.Linear.Internal (
Buffer,
runBuffer,
runBufferBS,
dupBuffer,
consumeBuffer,
eraseBuffer,
byteSizeOfBuffer,
lengthOfBuffer,
dropBuffer,
takeBuffer,
newEmptyBuffer,
appendBounded,
appendExact,
prependBounded,
prependBounded',
appendBounded',
prependExact,
(><),
) where
import Data.ByteString.Internal (ByteString (..))
import Data.Text qualified as T
import Data.Text.Array qualified as A
import Data.Text.Internal (Text (..))
import GHC.Exts (Int (..), Levity (..), RuntimeRep (..), TYPE, byteArrayContents#, plusAddr#, unsafeCoerce#)
import GHC.ForeignPtr (ForeignPtr (..), ForeignPtrContents (..))
import GHC.ST (ST (..), runST)
import Data.Text.Builder.Linear.Array
data Buffer ∷ TYPE ('BoxedRep 'Unlifted) where
Buffer ∷ {-# UNPACK #-} !Text → Buffer
unBuffer ∷ Buffer ⊸ Text
unBuffer :: Buffer %1 -> Text
unBuffer (Buffer Text
x) = Text
x
runBuffer ∷ (Buffer ⊸ Buffer) ⊸ Text
runBuffer :: (Buffer %1 -> Buffer) %1 -> Text
runBuffer Buffer %1 -> Buffer
f = Buffer %1 -> Text
unBuffer (Buffer %1 -> Buffer
shrinkBuffer (Buffer %1 -> Buffer
f (Text -> Buffer
Buffer Text
forall a. Monoid a => a
mempty)))
{-# NOINLINE runBuffer #-}
runBufferBS ∷ (Buffer ⊸ Buffer) ⊸ ByteString
runBufferBS :: (Buffer %1 -> Buffer) %1 -> ByteString
runBufferBS Buffer %1 -> Buffer
f = case Buffer %1 -> Buffer
shrinkBuffer (Buffer %1 -> Buffer
f (Text -> Buffer
Buffer Text
memptyPinned)) of
Buffer (Text (A.ByteArray ByteArray#
arr) (I# Int#
from) Int
len) → ForeignPtr Word8 -> Int -> ByteString
BS ForeignPtr Word8
fp Int
len
where
addr# :: Addr#
addr# = ByteArray# -> Addr#
byteArrayContents# ByteArray#
arr Addr# -> Int# -> Addr#
`plusAddr#` Int#
from
fp :: ForeignPtr Word8
fp = Addr# -> ForeignPtrContents -> ForeignPtr Word8
forall a. Addr# -> ForeignPtrContents -> ForeignPtr a
ForeignPtr Addr#
addr# (MutableByteArray# RealWorld -> ForeignPtrContents
PlainPtr (ByteArray# -> MutableByteArray# RealWorld
forall a b. a -> b
unsafeCoerce# ByteArray#
arr))
{-# NOINLINE runBufferBS #-}
shrinkBuffer ∷ Buffer ⊸ Buffer
shrinkBuffer :: Buffer %1 -> Buffer
shrinkBuffer (Buffer (Text ByteArray
arr Int
from Int
len)) = Text -> Buffer
Buffer (Text -> Buffer) -> Text -> Buffer
forall a b. (a -> b) -> a -> b
$ (forall s. ST s Text) -> Text
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s Text) -> Text) -> (forall s. ST s Text) -> Text
forall a b. (a -> b) -> a -> b
$ do
arrM ← ByteArray -> ST s (MArray s)
forall s. ByteArray -> ST s (MArray s)
unsafeThaw ByteArray
arr
A.shrinkM arrM (from + len)
arr' ← A.unsafeFreeze arrM
pure $ Text arr' from len
memptyPinned ∷ Text
memptyPinned :: Text
memptyPinned = (forall s. ST s Text) -> Text
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s Text) -> Text) -> (forall s. ST s Text) -> Text
forall a b. (a -> b) -> a -> b
$ do
marr ← Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.newPinned Int
0
arr ← A.unsafeFreeze marr
pure $ Text arr 0 0
newEmptyBuffer ∷ Buffer ⊸ (# Buffer, Buffer #)
newEmptyBuffer :: Buffer %1 -> (# Buffer, Buffer #)
newEmptyBuffer (Buffer t :: Text
t@(Text ByteArray
arr Int
_ Int
_)) =
(# Text -> Buffer
Buffer Text
t, Text -> Buffer
Buffer (if ByteArray -> Bool
isPinned ByteArray
arr then Text
memptyPinned else Text
forall a. Monoid a => a
mempty) #)
dupBuffer ∷ Buffer ⊸ (# Buffer, Buffer #)
dupBuffer :: Buffer %1 -> (# Buffer, Buffer #)
dupBuffer (Buffer Text
x) = (# Text -> Buffer
Buffer Text
x, Text -> Buffer
Buffer (Text -> Text
T.copy Text
x) #)
consumeBuffer ∷ Buffer ⊸ ()
consumeBuffer :: Buffer %1 -> ()
consumeBuffer Buffer {} = ()
eraseBuffer ∷ Buffer ⊸ Buffer
eraseBuffer :: Buffer %1 -> Buffer
eraseBuffer (Buffer (Text ByteArray
arr Int
_ Int
_)) =
Text -> Buffer
Buffer (if ByteArray -> Bool
isPinned ByteArray
arr then Text
memptyPinned else Text
forall a. Monoid a => a
mempty)
byteSizeOfBuffer ∷ Buffer ⊸ (# Buffer, Word #)
byteSizeOfBuffer :: Buffer %1 -> (# Buffer, Word #)
byteSizeOfBuffer (Buffer t :: Text
t@(Text ByteArray
_ Int
_ Int
len)) = (# Text -> Buffer
Buffer Text
t, Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len #)
lengthOfBuffer ∷ Buffer ⊸ (# Buffer, Word #)
lengthOfBuffer :: Buffer %1 -> (# Buffer, Word #)
lengthOfBuffer (Buffer Text
t) = (# Text -> Buffer
Buffer Text
t, Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Text -> Int
T.length Text
t) #)
dropBuffer ∷ Word → Buffer ⊸ Buffer
dropBuffer :: Word -> Buffer %1 -> Buffer
dropBuffer Word
nChar (Buffer t :: Text
t@(Text ByteArray
arr Int
off Int
len))
| Int
nByte Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Text -> Buffer
Buffer (ByteArray -> Int -> Int -> Text
Text ByteArray
arr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len) Int
0)
| Bool
otherwise = Text -> Buffer
Buffer (ByteArray -> Int -> Int -> Text
Text ByteArray
arr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
nByte) (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nByte))
where
nByte :: Int
nByte = Int -> Text -> Int
T.measureOff (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
nChar) Text
t
takeBuffer ∷ Word → Buffer ⊸ Buffer
takeBuffer :: Word -> Buffer %1 -> Buffer
takeBuffer Word
nChar (Buffer t :: Text
t@(Text ByteArray
arr Int
off Int
_))
| Int
nByte Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Text -> Buffer
Buffer Text
t
| Bool
otherwise = Text -> Buffer
Buffer (ByteArray -> Int -> Int -> Text
Text ByteArray
arr Int
off Int
nByte)
where
nByte :: Int
nByte = Int -> Text -> Int
T.measureOff (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
nChar) Text
t
appendBounded
∷ Int
→ (∀ s. A.MArray s → Int → ST s Int)
→ Buffer
⊸ Buffer
appendBounded :: Int
-> (forall s. MArray s -> Int -> ST s Int) -> Buffer %1 -> Buffer
appendBounded Int
maxSrcLen forall s. MArray s -> Int -> ST s Int
appender (Buffer (Text ByteArray
dst Int
dstOff Int
dstLen)) = Text -> Buffer
Buffer (Text -> Buffer) -> Text -> Buffer
forall a b. (a -> b) -> a -> b
$ (forall s. ST s Text) -> Text
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s Text) -> Text) -> (forall s. ST s Text) -> Text
forall a b. (a -> b) -> a -> b
$ do
let dstFullLen :: Int
dstFullLen = ByteArray -> Int
sizeofByteArray ByteArray
dst
newFullLen :: Int
newFullLen = Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
dstLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
maxSrcLen)
newM ←
if Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dstLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
maxSrcLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
dstFullLen
then ByteArray -> ST s (MArray s)
forall s. ByteArray -> ST s (MArray s)
unsafeThaw ByteArray
dst
else do
tmpM ← (if ByteArray -> Bool
isPinned ByteArray
dst then Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.newPinned else Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.new) Int
newFullLen
A.copyI dstLen tmpM dstOff dst dstOff
pure tmpM
srcLen ← appender newM (dstOff + dstLen)
new ← A.unsafeFreeze newM
pure $ Text new dstOff (dstLen + srcLen)
{-# INLINE appendBounded #-}
appendBounded'
∷ Int
→ (∀ s x. ((A.MArray s → Int → ST s Int) → ST s x) → ((A.MArray s → Int → ST s Int) → ST s x) → ST s x)
→ Buffer
⊸ Buffer
appendBounded' :: Int
-> (forall s x.
((MArray s -> Int -> ST s Int) -> ST s x)
-> ((MArray s -> Int -> ST s Int) -> ST s x) -> ST s x)
-> Buffer
%1 -> Buffer
appendBounded' Int
maxSrcLen forall s x.
((MArray s -> Int -> ST s Int) -> ST s x)
-> ((MArray s -> Int -> ST s Int) -> ST s x) -> ST s x
writer (Buffer (Text ByteArray
dst Int
dstOff Int
dstLen)) = Text -> Buffer
Buffer (Text -> Buffer) -> Text -> Buffer
forall a b. (a -> b) -> a -> b
$ (forall s. ST s Text) -> Text
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s Text) -> Text) -> (forall s. ST s Text) -> Text
forall a b. (a -> b) -> a -> b
$ do
let dstFullLen :: Int
dstFullLen = ByteArray -> Int
sizeofByteArray ByteArray
dst
newFullLen :: Int
newFullLen = Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
dstLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
maxSrcLen)
newM ←
if Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dstLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
maxSrcLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
dstFullLen
then ByteArray -> ST s (MArray s)
forall s. ByteArray -> ST s (MArray s)
unsafeThaw ByteArray
dst
else do
tmpM ← (if ByteArray -> Bool
isPinned ByteArray
dst then Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.newPinned else Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.new) Int
newFullLen
A.copyI dstLen tmpM dstOff dst dstOff
pure tmpM
let append = \MArray s -> Int -> ST s Int
appender → do
count ← MArray s -> Int -> ST s Int
appender MArray s
newM (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dstLen)
pure (dstOff, count)
let prepend = \MArray s -> Int -> ST s Int
prepender → case Int
dstLen of
Int
0 → do
count ← MArray s -> Int -> ST s Int
prepender MArray s
newM Int
maxSrcLen
pure (maxSrcLen - count, count)
Int
_ → do
let off' :: Int
off'
| Int
dstOff Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
maxSrcLen = Int
dstOff
| Bool
otherwise = Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dstLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
maxSrcLen
count ← MArray s -> Int -> ST s Int
prepender MArray s
newM Int
off'
A.copyM newM (dstOff + dstLen) newM (off' - count) count
pure (dstOff, count)
!(dstOff', srcLen) ← writer append prepend
new ← A.unsafeFreeze newM
pure $ Text new dstOff' (dstLen + srcLen)
{-# INLINE appendBounded' #-}
appendExact
∷ Int
→ (∀ s. A.MArray s → Int → ST s ())
→ Buffer
⊸ Buffer
appendExact :: Int
-> (forall s. MArray s -> Int -> ST s ()) -> Buffer %1 -> Buffer
appendExact Int
srcLen forall s. MArray s -> Int -> ST s ()
appender =
Int
-> (forall s. MArray s -> Int -> ST s Int) -> Buffer %1 -> Buffer
appendBounded
Int
srcLen
(\MArray s
dst Int
dstOff → MArray s -> Int -> ST s ()
forall s. MArray s -> Int -> ST s ()
appender MArray s
dst Int
dstOff ST s () -> ST s Int -> ST s Int
forall a b. ST s a -> ST s b -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ST s Int
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
srcLen)
{-# INLINE appendExact #-}
prependBounded
∷ Int
→ (∀ s. A.MArray s → Int → ST s Int)
→ (∀ s. A.MArray s → Int → ST s Int)
→ Buffer
⊸ Buffer
prependBounded :: Int
-> (forall s. MArray s -> Int -> ST s Int)
-> (forall s. MArray s -> Int -> ST s Int)
-> Buffer
%1 -> Buffer
prependBounded Int
maxSrcLen forall s. MArray s -> Int -> ST s Int
prepender forall s. MArray s -> Int -> ST s Int
appender (Buffer (Text ByteArray
dst Int
dstOff Int
dstLen))
| Int
maxSrcLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
dstOff = Text -> Buffer
Buffer (Text -> Buffer) -> Text -> Buffer
forall a b. (a -> b) -> a -> b
$ (forall s. ST s Text) -> Text
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s Text) -> Text) -> (forall s. ST s Text) -> Text
forall a b. (a -> b) -> a -> b
$ do
newM ← ByteArray -> ST s (MArray s)
forall s. ByteArray -> ST s (MArray s)
unsafeThaw ByteArray
dst
srcLen ← prepender newM dstOff
new ← A.unsafeFreeze newM
pure $ Text new (dstOff - srcLen) (srcLen + dstLen)
| Bool
otherwise = Text -> Buffer
Buffer (Text -> Buffer) -> Text -> Buffer
forall a b. (a -> b) -> a -> b
$ (forall s. ST s Text) -> Text
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s Text) -> Text) -> (forall s. ST s Text) -> Text
forall a b. (a -> b) -> a -> b
$ do
let dstFullLen :: Int
dstFullLen = ByteArray -> Int
sizeofByteArray ByteArray
dst
newOff :: Int
newOff = Int
dstLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
maxSrcLen
newFullLen :: Int
newFullLen = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
newOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
dstFullLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
dstLen)
newM ← (if ByteArray -> Bool
isPinned ByteArray
dst then Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.newPinned else Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.new) Int
newFullLen
srcLen ← appender newM newOff
A.copyI dstLen newM (newOff + srcLen) dst dstOff
new ← A.unsafeFreeze newM
pure $ Text new newOff (dstLen + srcLen)
{-# INLINE prependBounded #-}
prependBounded'
∷ Int
→ (∀ s. A.MArray s → Int → ST s Int)
→ Buffer
⊸ Buffer
prependBounded' :: Int
-> (forall s. MArray s -> Int -> ST s Int) -> Buffer %1 -> Buffer
prependBounded' Int
maxSrcLen forall s. MArray s -> Int -> ST s Int
prepender (Buffer (Text ByteArray
dst Int
dstOff Int
dstLen))
| Int
maxSrcLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
dstOff = Text -> Buffer
Buffer (Text -> Buffer) -> Text -> Buffer
forall a b. (a -> b) -> a -> b
$ (forall s. ST s Text) -> Text
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s Text) -> Text) -> (forall s. ST s Text) -> Text
forall a b. (a -> b) -> a -> b
$ do
newM ← ByteArray -> ST s (MArray s)
forall s. ByteArray -> ST s (MArray s)
unsafeThaw ByteArray
dst
srcLen ← prepender newM dstOff
new ← A.unsafeFreeze newM
pure $ Text new (dstOff - srcLen) (srcLen + dstLen)
| Bool
otherwise = Text -> Buffer
Buffer (Text -> Buffer) -> Text -> Buffer
forall a b. (a -> b) -> a -> b
$ (forall s. ST s Text) -> Text
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s Text) -> Text) -> (forall s. ST s Text) -> Text
forall a b. (a -> b) -> a -> b
$ do
let dstFullLen :: Int
dstFullLen = ByteArray -> Int
sizeofByteArray ByteArray
dst
off :: Int
off = Int
dstLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
maxSrcLen
newFullLen :: Int
newFullLen = Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
dstFullLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
dstOff)
newM ← (if ByteArray -> Bool
isPinned ByteArray
dst then Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.newPinned else Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.new) Int
newFullLen
srcLen ← prepender newM off
A.copyI dstLen newM off dst dstOff
new ← A.unsafeFreeze newM
pure $ Text new (off - srcLen) (dstLen + srcLen)
{-# INLINE prependBounded' #-}
prependExact
∷ Int
→ (∀ s. A.MArray s → Int → ST s ())
→ Buffer
⊸ Buffer
prependExact :: Int
-> (forall s. MArray s -> Int -> ST s ()) -> Buffer %1 -> Buffer
prependExact Int
srcLen forall s. MArray s -> Int -> ST s ()
appender =
Int
-> (forall s. MArray s -> Int -> ST s Int)
-> (forall s. MArray s -> Int -> ST s Int)
-> Buffer
%1 -> Buffer
prependBounded
Int
srcLen
(\MArray s
dst Int
dstOff → MArray s -> Int -> ST s ()
forall s. MArray s -> Int -> ST s ()
appender MArray s
dst (Int
dstOff Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
srcLen) ST s () -> ST s Int -> ST s Int
forall a b. ST s a -> ST s b -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ST s Int
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
srcLen)
(\MArray s
dst Int
dstOff → MArray s -> Int -> ST s ()
forall s. MArray s -> Int -> ST s ()
appender MArray s
dst Int
dstOff ST s () -> ST s Int -> ST s Int
forall a b. ST s a -> ST s b -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ST s Int
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
srcLen)
{-# INLINE prependExact #-}
(><) ∷ Buffer ⊸ Buffer ⊸ Buffer
infix 6 ><
Buffer (Text ByteArray
left Int
leftOff Int
leftLen) >< :: Buffer %1 -> Buffer %1 -> Buffer
>< Buffer (Text ByteArray
right Int
rightOff Int
rightLen) = Text -> Buffer
Buffer (Text -> Buffer) -> Text -> Buffer
forall a b. (a -> b) -> a -> b
$ (forall s. ST s Text) -> Text
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s Text) -> Text) -> (forall s. ST s Text) -> Text
forall a b. (a -> b) -> a -> b
$ do
let leftFullLen :: Int
leftFullLen = ByteArray -> Int
sizeofByteArray ByteArray
left
rightFullLen :: Int
rightFullLen = ByteArray -> Int
sizeofByteArray ByteArray
right
canCopyToLeft :: Bool
canCopyToLeft = Int
leftOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
leftLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rightLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
leftFullLen
canCopyToRight :: Bool
canCopyToRight = Int
leftLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
rightOff
shouldCopyToLeft :: Bool
shouldCopyToLeft = Bool
canCopyToLeft Bool -> Bool -> Bool
&& (Bool -> Bool
not Bool
canCopyToRight Bool -> Bool -> Bool
|| Int
leftLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
rightLen)
if Bool
shouldCopyToLeft
then do
newM ← ByteArray -> ST s (MArray s)
forall s. ByteArray -> ST s (MArray s)
unsafeThaw ByteArray
left
A.copyI rightLen newM (leftOff + leftLen) right rightOff
new ← A.unsafeFreeze newM
pure $ Text new leftOff (leftLen + rightLen)
else
if Bool
canCopyToRight
then do
newM ← ByteArray -> ST s (MArray s)
forall s. ByteArray -> ST s (MArray s)
unsafeThaw ByteArray
right
A.copyI leftLen newM (rightOff - leftLen) left leftOff
new ← A.unsafeFreeze newM
pure $ Text new (rightOff - leftLen) (leftLen + rightLen)
else do
let fullLen :: Int
fullLen = Int
leftOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
leftLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rightLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
rightFullLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
rightOff Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
rightLen)
newM ← (if ByteArray -> Bool
isPinned ByteArray
left Bool -> Bool -> Bool
|| ByteArray -> Bool
isPinned ByteArray
right then Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.newPinned else Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.new) Int
fullLen
A.copyI leftLen newM leftOff left leftOff
A.copyI rightLen newM (leftOff + leftLen) right rightOff
new ← A.unsafeFreeze newM
pure $ Text new leftOff (leftLen + rightLen)