Improve checked flag

src-checked/Op.hs

@@ -3,16 +3,43 @@
 
 module Op
   ( writeCharArray#
+  , copyByteArray#
+  , copyMutableByteArray#
   ) where
 
-import GHC.Exts ((<#),(>=#))
+import GHC.Exts ((<#),(>=#),State#,Int#,MutableByteArray#,ByteArray#,Char#)
 import GHC.Int (Int(I#))
 import qualified GHC.Exts as Exts
 
-writeCharArray# :: Exts.MutableByteArray# s -> Exts.Int# -> Exts.Char# -> Exts.State# s -> Exts.State# s 
+writeCharArray# :: MutableByteArray# s -> Int# -> Char# -> State# s -> State# s
 writeCharArray# arr i v st = case i <# 0# of
   1# -> error ("writeCharArray#: negative index " ++ show (I# i))
   _ -> case Exts.getSizeofMutableByteArray# arr st of
     (# st', sz #) -> case i >=# sz of
       1# -> error ("writeCharArray#: index " ++ show (I# i) ++ " >= length " ++ show (I# sz))
       _ -> Exts.writeCharArray# arr i v st'
+
+copyByteArray# :: ByteArray# -> Int# -> MutableByteArray# s -> Int# -> Int# -> State# s -> State# s
+copyByteArray# src soff dst doff len s0 =
+  case Exts.getSizeofMutableByteArray# dst s0 of
+    (# s1, sz #)
+      | I# soff >= 0
+      , I# doff >= 0
+      , I# len >= 0
+      , I# doff + I# len <= I# sz
+      , I# soff + I# len <= I# (Exts.sizeofByteArray# src)
+        -> Exts.copyByteArray# src soff dst doff len s1
+      | otherwise -> error "copyByteArray#: index range out of bounds"
+
+copyMutableByteArray# :: MutableByteArray# s -> Int# -> MutableByteArray# s -> Int# -> Int# -> State# s -> State# s
+copyMutableByteArray# src soff dst doff len s0 =
+  case Exts.getSizeofMutableByteArray# dst s0 of
+    (# s1, szDst #) -> case Exts.getSizeofMutableByteArray# src s1 of
+      (# s2, szSrc #)
+        | I# soff >= 0
+        , I# doff >= 0
+        , I# len >= 0
+        , I# doff + I# len <= I# szDst
+        , I# soff + I# len <= I# szSrc
+          -> Exts.copyMutableByteArray# src soff dst doff len s2
+        | otherwise -> error "copyMutableByteArray#: index range out of bounds"

src-unchecked/Op.hs

@@ -2,6 +2,7 @@
 
 module Op
   ( writeCharArray#
+  , copyByteArray#
   ) where
 
-import GHC.Exts (writeCharArray#)
+import GHC.Exts (writeCharArray#,copyByteArray#,copyMutableByteArray#)

src/Data/Bytes/Builder.hs

@@ -182,6 +182,7 @@ import qualified Data.Bytes.Builder.Bounded.Unsafe as UnsafeBounded
 import qualified Data.Primitive as PM
 import qualified Data.Text.Short as TS
 import qualified GHC.Exts as Exts
+import qualified Op as Op
 
 -- | Run a builder.
 run ::
@@ -384,9 +385,9 @@ bytes (Bytes (ByteArray src# ) (I# soff# ) (I# slen# )) = Builder
       1# -> case Exts.newByteArray# 0# s0 of
         (# s1, buf1 #) -> (# s1, buf1, 0#, 0#, Immutable src# soff# slen# (Mutable buf0 off0 cs0) #)
       _ -> case Exts.newByteArray# 4080# s0 of
-        (# s1, buf1 #) -> case Exts.copyByteArray# src# soff# buf1 0# slen# s1 of
+        (# s1, buf1 #) -> case Op.copyByteArray# src# soff# buf1 0# slen# s1 of
           s2 -> (# s2, buf1, slen#, 4080# -# slen#, Mutable buf0 off0 cs0 #)
-    _ -> let !s1 = Exts.copyByteArray# src# soff# buf0 off0 slen# s0 in
+    _ -> let s1 = Op.copyByteArray# src# soff# buf0 off0 slen# s0 in
       (# s1, buf0, off0 +# slen#, len0 -# slen#, cs0 #)
   )
 
@@ -397,9 +398,9 @@ copy :: Bytes -> Builder
 copy (Bytes (ByteArray src# ) (I# soff# ) (I# slen# )) = Builder
   (\buf0 off0 len0 cs0 s0 -> case len0 <# slen# of
     1# -> case Exts.newByteArray# newSz s0 of
-        (# s1, buf1 #) -> case Exts.copyByteArray# src# soff# buf1 0# slen# s1 of
+        (# s1, buf1 #) -> case Op.copyByteArray# src# soff# buf1 0# slen# s1 of
           s2 -> (# s2, buf1, slen#, newSz -# slen#, Mutable buf0 off0 cs0 #)
-    _ -> let !s1 = Exts.copyByteArray# src# soff# buf0 off0 slen# s0 in
+    _ -> let !s1 = Op.copyByteArray# src# soff# buf0 off0 slen# s0 in
       (# s1, buf0, off0 +# slen#, len0 -# slen#, cs0 #)
   )
   where
@@ -411,10 +412,10 @@ copyCons :: Word8 -> Bytes -> Builder
 copyCons (W8# w0) (Bytes (ByteArray src# ) (I# soff# ) (I# slen# )) = Builder
   (\buf0 off0 len0 cs0 s0 -> case len0 <# (slen# +# 1#) of
     1# -> case Exts.newByteArray# newSz s0 of
-        (# s1, buf1 #) -> case Exts.copyByteArray# src# soff# buf1 1# slen# s1 of
+        (# s1, buf1 #) -> case Op.copyByteArray# src# soff# buf1 1# slen# s1 of
           s2 -> case Exts.writeWord8Array# buf1 0# w0 s2 of
             s3 -> (# s3, buf1, slen# +# 1#, newSz -# (slen# +# 1#), Mutable buf0 off0 cs0 #)
-    _ -> let !s1 = Exts.copyByteArray# src# soff# buf0 (off0 +# 1#) slen# s0
+    _ -> let !s1 = Op.copyByteArray# src# soff# buf0 (off0 +# 1#) slen# s0
              !s2 = Exts.writeWord8Array# buf0 off0 w0 s1
           in (# s2, buf0, off0 +# (slen# +# 1#), len0 -# (slen# +# 1#), cs0 #)
   )
@@ -507,11 +508,11 @@ copy2 (Bytes (ByteArray srcA# ) (I# soffA# ) (I# slenA# ))
       (Bytes (ByteArray srcB# ) (I# soffB# ) (I# slenB# )) = Builder
   (\buf0 off0 len0 cs0 s0 -> case len0 <# slen# of
     1# -> case Exts.newByteArray# newSz s0 of
-        (# s1, buf1 #) -> case Exts.copyByteArray# srcA# soffA# buf1 0# slenA# s1 of
-          s2 -> case Exts.copyByteArray# srcB# soffB# buf1 slenA# slenB# s2 of
+        (# s1, buf1 #) -> case Op.copyByteArray# srcA# soffA# buf1 0# slenA# s1 of
+          s2 -> case Op.copyByteArray# srcB# soffB# buf1 slenA# slenB# s2 of
             s3 -> (# s3, buf1, slen#, newSz -# slen#, Mutable buf0 off0 cs0 #)
-    _ -> let !s1 = Exts.copyByteArray# srcA# soffA# buf0 off0 slenA# s0
-             !s2 = Exts.copyByteArray# srcB# soffB# buf0 (off0 +# slenA# ) slenB# s1 in
+    _ -> let !s1 = Op.copyByteArray# srcA# soffA# buf0 off0 slenA# s0
+             !s2 = Op.copyByteArray# srcB# soffB# buf0 (off0 +# slenA# ) slenB# s1 in
       (# s2, buf0, off0 +# slen#, len0 -# slen#, cs0 #)
   )
   where

src/Data/Bytes/Builder/Unsafe.hs

@@ -53,6 +53,7 @@ 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
+import qualified Op
 
 -- | An unmaterialized sequence of bytes that may be pasted
 -- into a mutable byte array.
@@ -203,11 +204,11 @@ copyReverseCommits# ::
 copyReverseCommits# _ off Initial s0 = (# s0, off #)
 copyReverseCommits# marr prevOff (Mutable arr sz cs) s0 =
   let !off = prevOff -# sz in
-  case Exts.copyMutableByteArray# arr 0# marr off sz s0 of
+  case Op.copyMutableByteArray# arr 0# marr off sz s0 of
     s1 -> copyReverseCommits# marr off cs s1
 copyReverseCommits# marr prevOff (Immutable arr soff sz cs) s0 =
   let !off = prevOff -# sz in
-  case Exts.copyByteArray# arr soff marr off sz s0 of
+  case Op.copyByteArray# arr soff marr off sz s0 of
     s1 -> copyReverseCommits# marr off cs s1
 
 -- | Create a builder from a cons-list of 'Char'. These