Skip to content

Commit

Permalink
add binding to the c memchr function.
Browse files Browse the repository at this point in the history
  • Loading branch information
anuragsoni committed May 5, 2021
1 parent 5237a8c commit 9e69d88
Show file tree
Hide file tree
Showing 5 changed files with 66 additions and 0 deletions.
10 changes: 10 additions & 0 deletions lib/bigstringaf.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down Expand Up @@ -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 *)

Expand Down
12 changes: 12 additions & 0 deletions lib/bigstringaf.mli
Original file line number Diff line number Diff line change
Expand Up @@ -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

(** {4 [memchr]}
Search for a byte in a bigstring using [memcmp]. Similar to [unsafe_memchr]
but this performs bounds checks.
*)
val memchr : t -> int -> char -> int -> int

(** {2 Memory-unsafe Operations}
Expand Down Expand Up @@ -267,3 +273,9 @@ 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

(** {4 [memchr]}
Search for a byte in a bigstring using [memcmp].
*)
val unsafe_memchr : t -> int -> char -> int -> int
19 changes: 19 additions & 0 deletions lib/bigstringaf_stubs.c
Original file line number Diff line number Diff line change
Expand Up @@ -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);
}
}
4 changes: 4 additions & 0 deletions lib_test/s.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
21 changes: 21 additions & 0 deletions lib_test/test_bigstringaf.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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)
Expand All @@ -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 =
Expand Down Expand Up @@ -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 () =
Expand Down

0 comments on commit 9e69d88

Please sign in to comment.