perf(stdune): avoid allocations in string and path helpers

otherlibs/dune-action-plugin/src/path.ml

@@ -1,6 +1,6 @@
 type t = string
 
-let concat = Filename.concat
+let concat = Stdune.Filename.concat
 let to_string t = t
 
 let of_string path =

otherlibs/stdune/src/filename.ml

@@ -2,6 +2,22 @@ include Stdlib.Filename
 
 type t = string
 
+let is_dir_sep =
+  if Sys.win32 || Sys.cygwin
+  then
+    function
+    | '/' | '\\' | ':' -> true
+    | _ -> false
+  else Char.equal '/'
+;;
+
+let concat dirname filename =
+  let length = String.length dirname in
+  if length = 0 || is_dir_sep (String.unsafe_get dirname (length - 1))
+  then 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))
 ;;

otherlibs/stdune/src/path0.ml

@@ -52,9 +52,9 @@ module Local_gen = struct
     if is_root t
     then None
     else (
-      match String.rindex_from t (String.length t - 1) '/' with
-      | None -> Some root
-      | Some i -> Some (String.take t i))
+      match String.rindex_from_unchecked t (String.length t - 1) '/' with
+      | -1 -> Some root
+      | i -> Some (String.take t i))
   ;;
 
   let basename t =
@@ -63,9 +63,9 @@ module Local_gen = struct
       then Code_error.raise "Path.Local.basename called on the root" []
       else (
         let len = String.length t in
-        match String.rindex_from t (len - 1) '/' with
-        | None -> t
-        | Some i -> String.sub t ~pos:(i + 1) ~len:(len - i - 1))
+        match String.rindex_from_unchecked t (len - 1) '/' with
+        | -1 -> t
+        | i -> String.sub t ~pos:(i + 1) ~len:(len - i - 1))
     in
     Filename.of_string_unchecked basename
   ;;
@@ -390,9 +390,13 @@ module Local_gen = struct
     if is_root t
     then None
     else (
-      match String.lsplit2 t ~on:'/' with
-      | None -> Some (Filename.of_string_unchecked t, root)
-      | Some (before, after) -> Some (Filename.of_string_unchecked before, after))
+      match String.index_from_unchecked t 0 '/' with
+      | -1 -> Some (Filename.of_string_unchecked t, root)
+      | separator ->
+        let length = String.length t in
+        let before = String.sub t ~pos:0 ~len:separator |> Filename.of_string_unchecked in
+        let after = String.sub t ~pos:(separator + 1) ~len:(length - separator - 1) in
+        Some (before, after))
   ;;
 
   let explode p =

otherlibs/stdune/src/string.ml

@@ -76,6 +76,21 @@ 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
+;;
+
+let rindex_from_unchecked s i c =
+  let rec loop i =
+    if i = -1 then -1 else if Char.equal (unsafe_get s i) c then i else loop (i - 1)
+  in
+  loop i
+;;
+
 (* [StringLabels] shadows these implementations with versions that allocate a
    local recursive closure on each call. *)
 let starts_with = Case_sensitive.starts_with

otherlibs/stdune/src/string.mli

@@ -52,6 +52,17 @@ val index : t -> char -> int option
 val index_from : t -> int -> char -> int option
 val rindex : t -> char -> int option
 val rindex_from : t -> int -> char -> int option
+
+(** [index_from_unchecked s pos char] returns the first index of [char] at or
+    after [pos], or [-1] if it is absent. [pos] must be between [0] and
+    [length s]. *)
+val index_from_unchecked : t -> int -> char -> int
+
+(** [rindex_from_unchecked s pos char] returns the last index of [char] at or
+    before [pos], or [-1] if it is absent. [pos] must be between [-1] and
+    [length s - 1]. *)
+val rindex_from_unchecked : t -> int -> char -> int
+
 val extract_words : t -> is_word_char:(char -> bool) -> t list
 val extract_comma_space_separated_words : t -> t list
 val extract_blank_separated_words : t -> t list

otherlibs/stdune/test/filename_tests.ml

@@ -30,6 +30,19 @@ let%expect_test "filenames reject platform directory separators" =
     |}]
 ;;
 
+let%expect_test "concat agrees with the standard library" =
+  let directories = [ ""; "."; "dir"; "dir/"; "dir\\"; "C:" ] in
+  let filenames = [ ""; "file"; "sub/file" ] in
+  List.iter directories ~f:(fun directory ->
+    List.iter filenames ~f:(fun filename ->
+      assert (
+        String.equal
+          (Filename.concat directory filename)
+          (Stdlib.Filename.concat directory filename))));
+  print_endline "all concatenations agree";
+  [%expect {| all concatenations agree |}]
+;;
+
 let extension s =
   let ext =
     Filename.of_string s

otherlibs/stdune/test/path_tests.ml

@@ -99,6 +99,29 @@ let%expect_test "local path parsing produces canonical representations" =
     |}]
 ;;
 
+let%expect_test "canonical local component boundaries" =
+  let option f = function
+    | None -> "none"
+    | Some value -> f value
+  in
+  List.iter [ "."; "one"; "one/two" ] ~f:(fun input ->
+    let path = Path.Local.of_string input in
+    let parent = Path.Local.parent path |> option Path.Local.to_string in
+    let basename = Path.Local.basename_opt path |> option Filename.to_string in
+    let first =
+      Path.Local.split_first_component path
+      |> option (fun (first, rest) ->
+        sprintf "%s,%s" (Filename.to_string first) (Path.Local.to_string rest))
+    in
+    printfn "%s: parent=%s basename=%s first=%s" input parent basename first);
+  [%expect
+    {|
+    .: parent=none basename=none first=none
+    one: parent=. basename=one first=one,.
+    one/two: parent=one basename=two first=one,two
+    |}]
+;;
+
 let%expect_test _ =
   let p = Path.(relative root) "foo" in
   descendant p ~of_:p;

otherlibs/stdune/test/string_tests.ml

@@ -220,6 +220,65 @@ let%expect_test "extract blank separated words" =
     |}]
 ;;
 
+let search_test_strings =
+  [ ""
+  ; "a"
+  ; "abcdefgh"
+  ; "abcdefghi"
+  ; String.init 257 ~f:(fun i -> Char.chr (i land 0xff))
+  ]
+;;
+
+let%expect_test "contains agrees with the standard library" =
+  List.iter search_test_strings ~f:(fun s ->
+    for code = 0 to 255 do
+      let char = Char.chr code in
+      assert (Bool.equal (String.contains s char) (Stdlib.String.contains s char))
+    done);
+  let unchanged = "unchanged" in
+  assert (String.escape_only 'x' unchanged == unchanged);
+  print_endline "all searches agree";
+  [%expect {| all searches agree |}]
+;;
+
+let%expect_test "forward searches agree with the standard library" =
+  List.iter search_test_strings ~f:(fun s ->
+    for pos = 0 to String.length s do
+      for code = 0 to 255 do
+        let char = Char.chr code in
+        let expected = Stdlib.String.index_from_opt s pos char in
+        assert (Option.equal Int.equal (String.index_from s pos char) expected);
+        assert (
+          Int.equal
+            (String.index_from_unchecked s pos char)
+            (Option.value expected ~default:(-1)));
+        assert (
+          Bool.equal
+            (String.contains_from s pos char)
+            (Stdlib.String.contains_from s pos char))
+      done
+    done);
+  print_endline "all searches agree";
+  [%expect {| all searches agree |}]
+;;
+
+let%expect_test "reverse searches agree with the standard library" =
+  List.iter search_test_strings ~f:(fun s ->
+    for pos = -1 to String.length s - 1 do
+      for code = 0 to 255 do
+        let char = Char.chr code in
+        let expected = Stdlib.String.rindex_from_opt s pos char in
+        assert (Option.equal Int.equal (String.rindex_from s pos char) expected);
+        assert (
+          Int.equal
+            (String.rindex_from_unchecked s pos char)
+            (Option.value expected ~default:(-1)))
+      done
+    done);
+  print_endline "all searches agree";
+  [%expect {| all searches agree |}]
+;;
+
 let%expect_test "split_lines preserves carriage returns outside CRLF" =
   List.iter [ "\r"; "first\n\r"; "first\rsecond"; "first\r\nsecond" ] ~f:(fun s ->
     String.split_lines s |> list string |> print_dyn);