Overwrite.hs

overwrite.hs

hPutMutableByteArray#

:: SIO.Handle

-> MutableByteArray# RealWorld -- ^ Invariant MUST BE PINNED

-> Int#

-> State# RealWorld

-> State# RealWorld

hPutMutableByteArray# h marr off s0 =

case byteArrayContents# (unsafeMutableByteArrayToByteArray# marr) of

addr -> case SIO.hPutBuf h (Ptr addr) (I# off) of

IO hPutBufAction -> case hPutBufAction s0 of

(# s1, _ #) -> s1

where

{-# INLINE unsafeMutableByteArrayToByteArray# #-}

unsafeMutableByteArrayToByteArray# :: MutableByteArray# s -> ByteArray#

unsafeMutableByteArrayToByteArray# = unsafeCoerce#

toHandleCallback

:: SIO.Handle

-> Buffer# RealWorld

-> Int#

-> State# RealWorld

-> (# State# RealWorld, Buffer# RealWorld #)

toHandleCallback h (# marr0, off0 #) needed s0 =

case getSizeofMutableByteArray# marr0 s0 of

(# s1, len #) -> case needed >=# len of

-- More buffer is needed than length so do standard growable vector doubling

1# -> case newPinnedByteArray# (max# (len *# 2#) (off0 +# needed)) s1 of

(# s2, marr1 #) -> case copyMutableByteArray# marr0 0# marr1 0# len s2 of

s3 -> (# s3, (# marr1, off0 #) #)

-- Less than the length of the buffer is needed so write the contents to the

-- handle and start the offset back at 0.

_ -> case hPutMutableByteArray# h marr0 off0 s1 of

s2 -> (# s2, (# marr0, 0# #) #)

flush :: SIO.Handle -> Buffer -> IO ()

flush h (Buffer marr off) = IO $ \s0 ->

case hPutMutableByteArray# h marr off s0 of

s1 -> (# s1, () #)