perf(stdune): use memchr for string searches

bin/subst.ml

@@ -66,12 +66,9 @@ let subst_string s path ~map =
     loop 1 0 0
   in
   let rec loop i acc =
-    if i = len
-    then acc
-    else (
-      match s.[i] with
-      | '%' -> after_percent (i + 1) acc
-      | _ -> loop (i + 1) acc)
+    match String.index_from_unchecked s i '%' with
+    | -1 -> acc
+    | percent -> after_percent (percent + 1) acc
   and after_percent i acc =
     if i = len
     then acc

otherlibs/stdune/src/ansi_color.ml

@@ -538,26 +538,35 @@ let escape_sequence_end str ~start =
 ;;
 
 let strip str =
-  match String.index_from str 0 '\027' with
-  | None -> str
-  | Some first_escape ->
-    let len = String.length str in
+  let len = String.length str in
+  match String.index_from_unchecked str 0 '\027' with
+  | -1 -> str
+  | first_escape ->
     let buf = Buffer.create len in
-    let rec loop start i =
+    (* Keep nearby escape sequences in OCaml and use memchr for longer spans. *)
+    let rec loop start i search_after =
       if i = len
       then (
-        Buffer.add_substring buf str start (i - start);
+        Buffer.add_substring buf str start (len - start);
         Buffer.contents buf)
+      else if i = search_after
+      then (
+        match String.index_from_unchecked str i '\027' with
+        | -1 ->
+          Buffer.add_substring buf str start (len - start);
+          Buffer.contents buf
+        | escape -> loop start escape (min len (escape + 8)))
       else if str.[i] = '\027'
       then (
         match escape_sequence_end str ~start:i with
-        | None -> loop start (i + 1)
+        | None -> loop start (i + 1) search_after
         | Some (sequence_end, _) ->
           Buffer.add_substring buf str start (i - start);
-          loop (sequence_end + 1) (sequence_end + 1))
-      else loop start (i + 1)
+          let start = sequence_end + 1 in
+          loop start start (min len (start + 8)))
+      else loop start (i + 1) search_after
     in
-    loop 0 first_escape
+    loop 0 first_escape (min len (first_escape + 8))
 ;;
 
 let rec parse_styles l (accu : Style.t list) =

otherlibs/stdune/src/bytes.ml

@@ -1 +1,10 @@
 include StdLabels.Bytes
+
+external index_in_range_unchecked
+  :  t
+  -> pos:int
+  -> len:int
+  -> char
+  -> int
+  = "dune_bytes_index_in_range"
+[@@noalloc]

otherlibs/stdune/src/bytes.mli

@@ -1,3 +1,8 @@
 include module type of struct
   include StdLabels.Bytes
 end
+
+(** [index_in_range_unchecked bytes ~pos ~len char] returns the first index of
+    [char] between [pos] and [pos + len], excluding the latter, or [-1] if it is
+    absent. The range must be within [bytes]. *)
+val index_in_range_unchecked : t -> pos:int -> len:int -> char -> int

otherlibs/stdune/src/dune

@@ -31,6 +31,7 @@
    platform_stubs
    copyfile_stubs
    signal_stubs
+   string_stubs
    time_stubs)))
 
 (rule

otherlibs/stdune/src/filename.ml

@@ -18,18 +18,19 @@ let concat dirname filename =
   else String.append_with_char dirname ~sep:(String.unsafe_get dir_sep 0) filename
 ;;
 
-let rec contains_slash s i =
-  i >= 0 && (Char.equal (String.unsafe_get s i) '/' || contains_slash s (i - 1))
-;;
-
-let rec contains_dir_sep s i =
+let rec contains_windows_dir_sep s i =
   if i < 0
   then false
   else (
     match String.unsafe_get s i with
-    | '/' -> true
-    | ('\\' | ':') when Sys.win32 || Sys.cygwin -> true
-    | _ -> contains_dir_sep s (i - 1))
+    | '/' | '\\' | ':' -> true
+    | _ -> contains_windows_dir_sep s (i - 1))
+;;
+
+let contains_dir_sep s =
+  if Sys.win32 || Sys.cygwin
+  then contains_windows_dir_sep s (String.length s - 1)
+  else String.contains s '/'
 ;;
 
 let is_valid s =
@@ -40,7 +41,7 @@ let is_valid s =
       || not
            (Char.equal (String.unsafe_get s 0) '.'
             && Char.equal (String.unsafe_get s 1) '.'))
-  && not (contains_dir_sep s (len - 1))
+  && not (contains_dir_sep s)
 ;;
 
 let of_string s = Option.some_if (is_valid s) s
@@ -111,9 +112,7 @@ module Extension = struct
 
   let is_valid s =
     let len = String.length s in
-    len > 0
-    && Char.equal (String.unsafe_get s 0) '.'
-    && not (contains_dir_sep s (len - 1))
+    len > 0 && Char.equal (String.unsafe_get s 0) '.' && not (contains_dir_sep s)
   ;;
 
   let of_string s = Option.some_if (is_valid s) s
@@ -245,9 +244,7 @@ type program_name_kind =
 let analyze_program_name fn =
   if not (is_relative fn)
   then Absolute
-  else if
-    contains_slash fn (String.length fn - 1)
-    || (Stdlib.Sys.win32 && String.contains fn '\\')
+  else if String.contains fn '/' || (Stdlib.Sys.win32 && String.contains fn '\\')
   then Relative_to_current_dir
   else In_path
 ;;

otherlibs/stdune/src/io.ml

@@ -19,7 +19,7 @@ let input_lines =
 ;;
 
 let input_zero_from_buffer from buf =
-  match String.index_from_opt buf from '\x00' with
+  match String.index_from buf from '\x00' with
   | None -> None
   | Some eos -> Some (String.sub buf ~pos:from ~len:(eos - from), eos + 1)
 ;;

otherlibs/stdune/src/path0.ml

@@ -11,26 +11,47 @@ let is_dir_sep =
 let basename_opt ~is_root ~basename t = if is_root t then None else Some (basename t)
 
 let explode_path =
-  let rec start acc path i =
-    if i < 0
-    then acc
-    else if is_dir_sep (String.unsafe_get path i)
-    then start acc path (i - 1)
-    else component acc path i (i - 1)
-  and component acc path end_ i =
-    if i < 0
-    then String.take path (end_ + 1) :: acc
-    else if is_dir_sep (String.unsafe_get path i)
-    then start (String.sub path ~pos:(i + 1) ~len:(end_ - i) :: acc) path (i - 1)
-    else component acc path end_ (i - 1)
-  in
-  fun path ->
-    if path = Filename.current_dir_name
-    then [ path ]
-    else (
-      match start [] path (String.length path - 1) with
-      | "." :: xs -> xs
-      | xs -> xs)
+  if Sys.win32 || Sys.cygwin
+  then (
+    let rec start acc path i =
+      if i < 0
+      then acc
+      else if is_dir_sep (String.unsafe_get path i)
+      then start acc path (i - 1)
+      else component acc path i (i - 1)
+    and component acc path end_ i =
+      if i < 0
+      then String.take path (end_ + 1) :: acc
+      else if is_dir_sep (String.unsafe_get path i)
+      then start (String.sub path ~pos:(i + 1) ~len:(end_ - i) :: acc) path (i - 1)
+      else component acc path end_ (i - 1)
+    in
+    fun path ->
+      if path = Filename.current_dir_name
+      then [ path ]
+      else (
+        match start [] path (String.length path - 1) with
+        | "." :: xs -> xs
+        | xs -> xs))
+  else (
+    let rec components path length start =
+      if start = length
+      then []
+      else (
+        match String.index_from_unchecked path start '/' with
+        | -1 -> [ String.sub path ~pos:start ~len:(length - start) ]
+        | separator when separator = start -> components path length (start + 1)
+        | separator ->
+          String.sub path ~pos:start ~len:(separator - start)
+          :: components path length (separator + 1))
+    in
+    fun path ->
+      if path = Filename.current_dir_name
+      then [ path ]
+      else (
+        match components path (String.length path) 0 with
+        | "." :: xs -> xs
+        | xs -> xs))
 ;;
 
 module Local_gen = struct

otherlibs/stdune/src/spawn.ml

@@ -1,5 +1,3 @@
-external contains_null : string -> bool = "dune_spawn_contains_null" [@@noalloc]
-
 module Working_dir = struct
   type 'a gen =
     | Path of string
@@ -224,7 +222,7 @@ let spawn_windows
 ;;
 
 let no_null s =
-  if contains_null s
+  if String.contains s '\000'
   then
     Printf.ksprintf
       invalid_arg

otherlibs/stdune/src/spawn_stubs.c

@@ -209,11 +209,6 @@ static int __pthread_fchdir(int fd) {
 
 #endif
 
-CAMLprim value dune_spawn_contains_null(value v_string)
-{
-  return Val_bool(memchr(String_val(v_string), '\0', caml_string_length(v_string)) != NULL);
-}
-
 #if !defined(_WIN32)
 
 # if defined(USE_POSIX_SPAWN)

otherlibs/stdune/src/string.ml

@@ -76,13 +76,8 @@ module Caseless = Cased_functions (struct
 
 include Stdlib.StringLabels
 
-let index_from_unchecked s i c =
-  let length = length s in
-  let rec loop i =
-    if i = length then -1 else if Char.equal (unsafe_get s i) c then i else loop (i + 1)
-  in
-  loop i
-;;
+external index_from_unchecked : t -> int -> char -> int = "dune_string_index_from"
+[@@noalloc]
 
 let rindex_from_unchecked s i c =
   let rec loop i =
@@ -91,6 +86,30 @@ let rindex_from_unchecked s i c =
   loop i
 ;;
 
+let index_from s i c =
+  let length = length s in
+  if i < 0 || i > length then invalid_arg "String.index_from_opt / Bytes.index_from_opt";
+  if i = length
+  then None
+  else (
+    match index_from_unchecked s i c with
+    | -1 -> None
+    | index -> Some index)
+;;
+
+let index s c = index_from s 0 c
+
+let contains_from s i c =
+  let length = length s in
+  if i < 0 || i > length then invalid_arg "String.contains_from / Bytes.contains_from";
+  i < length && index_from_unchecked s i c <> -1
+;;
+
+let contains s c =
+  let length = length s in
+  length > 0 && index_from_unchecked s 0 c <> -1
+;;
+
 (* [StringLabels] shadows these implementations with versions that allocate a
    local recursive closure on each call. *)
 let starts_with = Case_sensitive.starts_with
@@ -116,8 +135,6 @@ let capitalize = capitalize_ascii
 let uncapitalize = uncapitalize_ascii
 let uppercase = uppercase_ascii
 let lowercase = lowercase_ascii
-let index = index_opt
-let index_from s i c = index_from_opt s i c
 let rindex = rindex_opt
 let rindex_from s i c = rindex_from_opt s i c
 let break s ~pos = sub s ~pos:0 ~len:pos, sub s ~pos ~len:(length s - pos)
@@ -182,15 +199,17 @@ let rsplit2 s ~on =
 
 include String_split
 
+let split_on_char ~sep s = split s ~on:sep
+
 let escape_only c s =
-  let n = ref 0 in
-  let len = length s in
-  for i = 0 to len - 1 do
-    if unsafe_get s i = c then incr n
-  done;
-  if !n = 0
+  if not (contains s c)
   then s
   else (
+    let n = ref 0 in
+    let len = length s in
+    for i = 0 to len - 1 do
+      if unsafe_get s i = c then incr n
+    done;
     let b = Bytes.create (len + !n) in
     n := 0;
     for i = 0 to len - 1 do
@@ -226,7 +245,7 @@ let quoted = Printf.sprintf "%S"
 
 let maybe_quoted s =
   let escaped = escaped s in
-  if (s == escaped || s = escaped) && not (String.contains s ' ') then s else quoted s
+  if (s == escaped || s = escaped) && not (contains s ' ') then s else quoted s
 ;;
 
 include Comparable.Make (T)

otherlibs/stdune/src/string.mli

@@ -48,6 +48,8 @@ val capitalize : t -> t
 val uncapitalize : t -> t
 val uppercase : t -> t
 val lowercase : t -> t
+val contains : t -> char -> bool
+val contains_from : t -> int -> char -> bool
 val index : t -> char -> int option
 val index_from : t -> int -> char -> int option
 val rindex : t -> char -> int option
@@ -84,6 +86,7 @@ val rsplit2 : t -> on:char -> (t * t) option
     the original string [s]. *)
 val split : t -> on:char -> t list
 
+val split_on_char : sep:char -> t -> t list
 val split_lines : t -> t list
 
 (** Escape ONLY one character. {!escape} also escapes '\n',... and transforms