Merge pull request #47 from anuragsoni/add-memchr

add binding to C's memchr function.

lib/bigstringaf.ml

@@ -34,6 +34,9 @@ external unsafe_memcmp : t -> int -> t -> int -> int -> int =
 external unsafe_memcmp_string : t -> int -> string -> int -> int -> int =
   "bigstringaf_memcmp_string" [@@noalloc]
 
+external unsafe_memchr : t -> int -> char -> int -> int =
+  "bigstringaf_memchr" [@@noalloc]
+
 let sub t ~off ~len =
   BA1.sub t off len
 
@@ -189,6 +192,13 @@ let memcmp_string buf1 buf1_off buf2 buf2_off len =
   unsafe_memcmp_string buf1 buf1_off buf2 buf2_off len
 ;;
 
+let memchr buf buf_off chr len =
+  let buf_len = length buf in
+  if len < 0
+  then invalid_bounds "memchr" buf_len buf_off len;
+  if buf_off < 0 || buf_len - buf_off < len
+  then invalid_bounds "memchr" buf_len buf_off len;
+  unsafe_memchr buf buf_off chr len
 
 (* Safe operations *)
 

lib/bigstringaf.mli

@@ -164,6 +164,12 @@ val blit_to_bytes : t -> src_off:int -> Bytes.t -> dst_off:int -> len:int -> uni
 val memcmp        : t -> int -> t      -> int -> int -> int
 val memcmp_string : t -> int -> string -> int -> int -> int
 
+(** {3 [memchr]}
+
+    Search for a byte using [memchr], returning [-1] if the byte is not found.
+    Performing bounds checking before the C call. *)
+
+val memchr : t -> int -> char -> int -> int
 
 (** {2 Memory-unsafe Operations}
 
@@ -267,3 +273,10 @@ val unsafe_blit_to_bytes : t -> src_off:int -> Bytes.t -> dst_off:int -> len:int
 
 val unsafe_memcmp        : t -> int -> t      -> int -> int -> int
 val unsafe_memcmp_string : t -> int -> string -> int -> int -> int
+
+(** {3 [memchr]}
+
+    Search for a byte using [memchr], returning [-1] if the byte is not found.
+    It does not check bounds before the C call. *)
+
+val unsafe_memchr : t -> int -> char -> int -> int

lib/bigstringaf_stubs.c

@@ -83,3 +83,22 @@ bigstringaf_memcmp_string(value vba, value vba_off, value vstr, value vstr_off,
     int result = memcmp(buf1, buf2, len);
     return Val_int(result);
 }
+
+CAMLprim value
+bigstringaf_memchr(value vba, value vba_off, value vchr, value vlen)
+{
+    size_t off = Unsigned_long_val(vba_off);
+    char *buf = ((char *)Caml_ba_data_val(vba)) + off;
+    size_t len = Unsigned_long_val(vlen);
+    int c = Int_val(vchr);
+
+    char* res = memchr(buf, c, len);
+    if (res == NULL)
+    {
+        return Val_long(-1);
+    }
+    else
+    {
+        return Val_long(off + res - buf);
+    }
+}

lib/runtime.js

@@ -68,3 +68,14 @@ function bigstringaf_memcmp_string(ba, ba_off, str, str_off, len) {
   }
   return 0;
 }
+
+//Provides: bigstringaf_memchr
+//Requires: caml_ba_get_1
+function bigstringaf_memchr(ba, ba_off, chr, len) {
+  for (var i = 0; i < len; i++) {
+    if (caml_ba_get_1(ba, ba_off + i) == chr) {
+      return (ba_off + i);
+    }
+  }
+  return -1;
+}

lib_test/s.ml

@@ -36,3 +36,7 @@ module type Memcmp = sig
   val memcmp : Bigstringaf.t -> int -> Bigstringaf.t -> int -> int -> int
   val memcmp_string : Bigstringaf.t -> int -> String.t -> int -> int -> int
 end
+
+module type Memchr = sig
+  val memchr : Bigstringaf.t -> int -> char -> int -> int
+end

lib_test/test_bigstringaf.ml

@@ -233,6 +233,19 @@ let memcmp_string m () =
   ()
 ;;
 
+let memchr m () =
+  let module Memchr = (val m : S.Memchr) in
+  let open Memchr in
+  let string = "hello world foo bar baz" in
+  let buffer = Bigstringaf.of_string ~off:0 ~len:(String.length string) string in
+  let buffer_len = Bigstringaf.length buffer in
+  Alcotest.(check int) "memchr starting at offset 0" (String.index_from string 0 ' ')
+    (memchr buffer 0 ' ' buffer_len);
+  Alcotest.(check int) "memchr with an offset" (String.index_from string 7 ' ')
+    (memchr buffer 7 ' ' (buffer_len - 7));
+  Alcotest.(check int) "memchr char not found" (-1)
+    (memchr buffer 0 'Z' buffer_len)
+
 let negative_bounds_check () =
   let open Bigstringaf in
   let buf = Bigstringaf.empty in
@@ -293,6 +306,7 @@ let safe_operations =
   let module Setters : S.Setters = Bigstringaf in
   let module Blit    : S.Blit    = Bigstringaf in
   let module Memcmp  : S.Memcmp  = Bigstringaf in
+  let module Memchr  : S.Memchr  = Bigstringaf in
   [ "index out of bounds", `Quick, index_out_of_bounds
   ; "getters"            , `Quick, getters         (module Getters)
   ; "setters"            , `Quick, setters         (module Setters)
@@ -302,6 +316,7 @@ let safe_operations =
   ; "memcmp"             , `Quick, memcmp          (module Memcmp)
   ; "memcmp_string"      , `Quick, memcmp_string   (module Memcmp)
   ; "negative length"    , `Quick, negative_bounds_check
+  ; "memchr"             , `Quick, memchr          (module Memchr)
   ]
 
 let unsafe_operations =
@@ -348,13 +363,19 @@ let unsafe_operations =
     let memcmp = unsafe_memcmp
     let memcmp_string = unsafe_memcmp_string
   end in
+  let module Memchr : S.Memchr = struct
+    open Bigstringaf
+
+    let memchr = unsafe_memchr
+  end in
   [ "getters"        , `Quick, getters         (module Getters)
   ; "setters"        , `Quick, setters         (module Setters)
   ; "blit"           , `Quick, blit            (module Blit)
   ; "blit_to_bytes"  , `Quick, blit_to_bytes   (module Blit)
   ; "blit_from_bytes", `Quick, blit_from_bytes (module Blit)
   ; "memcmp"         , `Quick, memcmp          (module Memcmp)
   ; "memcmp_string"  , `Quick, memcmp_string   (module Memcmp)
+  ; "memchr"         , `Quick, memchr          (module Memchr)
   ]
 
 let () =