Misc performance improvements

src/lib.ml

@@ -1,35 +1,48 @@
 module String = struct
   let is_prefix ~prefix str =
-    let pl = String.length prefix in
-    if String.length str < pl then
-      false
+    let rec aux i ~prefix_len ~prefix ~str =
+      if i < (prefix_len : int) then
+        if Char.equal
+             (String.unsafe_get str i)
+             (String.unsafe_get prefix i) then
+          aux (i + 1) ~prefix_len ~prefix ~str
+        else
+          false
+      else
+        true
+    in
+    let prefix_len = String.length prefix in
+    if prefix_len <= (String.length str : int) then
+      aux 0 ~prefix_len ~prefix ~str
     else
-      String.sub str 0 (String.length prefix) = prefix
+      false
 
   let is_suffix ~suffix str =
-    let pl = String.length suffix in
-    if String.length str < pl then
-      false
+    let rec aux suffix_i str_i ~suffix_len ~suffix ~str =
+      if suffix_i < (suffix_len : int) then
+        if Char.equal
+             (String.unsafe_get str str_i)
+             (String.unsafe_get suffix suffix_i) then
+          aux (suffix_i + 1) (str_i + 1) ~suffix_len ~suffix ~str
+        else
+          false
+      else
+        true
+    in
+    let suffix_len = String.length suffix in
+    let str_len = String.length str in
+    if suffix_len <= (str_len : int) then
+      aux 0 (str_len - suffix_len) ~suffix_len ~suffix ~str
     else
-      String.sub str (String.length str - pl) pl = suffix
+      false
 
   let cut sep str =
-    try
-      let idx = String.index str sep
-      and l = String.length str
-      in
-      let sidx = succ idx in
-      Some (String.sub str 0 idx, String.sub str sidx (l - sidx))
-    with
-      Not_found -> None
-
-  let cuts sep str =
-    let rec doit acc s =
-      match cut sep s with
-      | None -> List.rev (s :: acc)
-      | Some (a, b) -> doit (a :: acc) b
-    in
-    doit [] str
+    match String.index_opt str sep with
+    | Some idx ->
+        let l = String.length str in
+        let sidx = idx + 1 in
+        Some (String.sub str 0 idx, String.sub str sidx (l - sidx))
+    | None -> None
 
   let slice ?(start = 0) ?stop str =
     let stop = match stop with
@@ -42,7 +55,9 @@ module String = struct
   let count_common_suffix x y =
     let rec loop ~x ~y acc ix iy =
       if ix >= 0 && iy >= 0 &&
-         String.unsafe_get x ix = (String.unsafe_get y iy : char) then
+         Char.equal
+           (String.unsafe_get x ix)
+           (String.unsafe_get y iy) then
         loop ~x ~y (acc + 1) (ix - 1) (iy - 1)
       else
         acc
@@ -51,10 +66,3 @@ module String = struct
     let len_y = String.length y in
     loop ~x ~y 0 (len_x - 1) (len_y - 1)
 end
-
-module List = struct
-  let rec last = function
-    | [] -> invalid_arg "List.last"
-    | [x] -> x
-    | _::xs -> last xs
-end

src/lib.mli

@@ -2,11 +2,6 @@ module String : sig
   val is_prefix : prefix:string -> string -> bool
   val is_suffix : suffix:string -> string -> bool
   val cut : char -> string -> (string * string) option
-  val cuts : char -> string -> string list
   val slice : ?start:int -> ?stop:int -> string -> string
   val count_common_suffix : string -> string -> int
 end
-
-module List : sig
-  val last : 'a list -> 'a
-end

src/patch.ml

@@ -73,7 +73,7 @@ let rec apply_hunk ~cleanly ~fuzz (last_matched_line, offset, rope) ({mine_start
         if search_offset > max_pos_offset && search_offset > max_neg_offset then
           if fuzz < 3 && List.length mine >= 2 && List.length their >= 2 then
             let hunk =
-              if List.hd hunk.mine = (List.hd hunk.their : string) then
+              if String.equal (List.hd hunk.mine) (List.hd hunk.their) then
                 {
                   mine_start = hunk.mine_start + 1;
                   mine_len = hunk.mine_len - 1;
@@ -86,21 +86,23 @@ let rec apply_hunk ~cleanly ~fuzz (last_matched_line, offset, rope) ({mine_start
                 hunk
             in
             let hunk =
-              if Lib.List.last hunk.mine = (Lib.List.last hunk.their : string) then
+              let rev_mine = List.rev hunk.mine in
+              let rev_their = List.rev hunk.their in
+              if String.equal (List.hd rev_mine) (List.hd rev_their) then
                 {
                   mine_start = hunk.mine_start;
                   mine_len = hunk.mine_len - 1;
-                  mine = List.rev (List.tl (List.rev hunk.mine));
+                  mine = List.rev (List.tl rev_mine);
                   their_start = hunk.their_start;
                   their_len = hunk.their_len - 1;
-                  their = List.rev (List.tl (List.rev hunk.their));
+                  their = List.rev (List.tl rev_their);
                 }
               else
                 hunk
             in
             if hunk.mine_len = 0 && hunk.their_len = 0 then
               invalid_arg "apply_hunk: equal hunks... why?!"
-            else if mine_len = (hunk.mine_len : int) && their_len = (hunk.their_len : int) then
+            else if Int.equal mine_len hunk.mine_len && Int.equal their_len hunk.their_len then
               invalid_arg "apply_hunk: could not apply fuzz"
             else
               apply_hunk ~cleanly ~fuzz:(fuzz + 1) (last_matched_line, offset, rope) hunk
@@ -127,7 +129,7 @@ let count_to_sl_sl data =
   if Lib.String.is_prefix ~prefix:"@@ -" data then
     (* input: "@@ -19,23 +19,12 @@ bla" *)
     (* output: ((19,23), (19, 12)) *)
-    match List.filter (function "" -> false | _ -> true) (Lib.String.cuts '@' data) with
+    match List.filter (function "" -> false | _ -> true) (String.split_on_char '@' data) with
     | numbers::_ ->
        let nums = String.trim numbers in
        (match Lib.String.cut ' ' nums with
@@ -147,11 +149,11 @@ let sort_into_bags ~counter:(mine_len, their_len) dir mine their m_nl t_nl str =
     Some (counter, `Both, (data :: mine), (data :: their), m_nl, t_nl)
   in
   let str_len = String.length str in
-  if mine_len = 0 && their_len = 0 && (str_len = 0 || str.[0] <> '\\') then
+  if mine_len = 0 && their_len = 0 && (str_len = 0 || String.unsafe_get str 0 <> '\\') then
     None
   else if str_len = 0 then
     both "" (* NOTE: this should technically be a parse error but GNU patch accepts that and some patches in opam-repository do use this behaviour *)
-  else match String.get str 0, Lib.String.slice ~start:1 str with
+  else match String.unsafe_get str 0, Lib.String.slice ~start:1 str with
     | ' ', data ->
         both data
     | '\t', data ->
@@ -246,30 +248,30 @@ let pp_filename ppf fn =
   (* NOTE: filename quote format from GNU diffutils *)
   let rec aux ~to_quote buf fn ~len i =
     if i < len then
-      let c = fn.[i] in
       let to_quote =
-        if c = '\007' then
-          (Buffer.add_string buf "\\a"; true)
-        else if c = '\b' then
-          (Buffer.add_string buf "\\b"; true)
-        else if c = '\t' then
-          (Buffer.add_string buf "\\t"; true)
-        else if c = '\n' then
-          (Buffer.add_string buf "\\n"; true)
-        else if c = '\011' then
-          (Buffer.add_string buf "\\v"; true)
-        else if c = '\012' then
-          (Buffer.add_string buf "\\f"; true)
-        else if c = '\r' then
-          (Buffer.add_string buf "\\r"; true)
-        else if c < ' ' || c > '~' then
-          (Printf.bprintf buf "\\%03o" (Char.code c); true)
-        else if c = ' ' then
-          (Buffer.add_char buf ' '; true)
-        else if c = '"' || c = '\\' then
-          (Buffer.add_char buf '\\'; Buffer.add_char buf c; true)
-        else
-          (Buffer.add_char buf c; to_quote)
+        match String.unsafe_get fn i with
+        | '\007' ->
+            Buffer.add_string buf "\\a"; true
+        | '\b' ->
+            Buffer.add_string buf "\\b"; true
+        | '\t' ->
+            Buffer.add_string buf "\\t"; true
+        | '\n' ->
+            Buffer.add_string buf "\\n"; true
+        | '\011' ->
+            Buffer.add_string buf "\\v"; true
+        | '\012' ->
+            Buffer.add_string buf "\\f"; true
+        | '\r' ->
+            Buffer.add_string buf "\\r"; true
+        | ' ' ->
+            Buffer.add_char buf ' '; true
+        | ('"' | '\\') as c ->
+            Buffer.add_char buf '\\'; Buffer.add_char buf c; true
+        | c when c < ' ' || c > '~' ->
+            Printf.bprintf buf "\\%03o" (Char.code c); true
+        | c ->
+            Buffer.add_char buf c; to_quote
       in
       aux ~to_quote buf fn ~len (i + 1)
     else
@@ -280,7 +282,7 @@ let pp_filename ppf fn =
   if aux ~to_quote:false buf fn ~len 0 then
     Format.fprintf ppf "\"%s\"" (Buffer.contents buf)
   else
-    Format.pp_print_text ppf fn
+    Format.pp_print_string ppf fn
 
 let pp_operation ppf = function
   | Edit (old_name, new_name) ->
@@ -333,7 +335,7 @@ let strip_prefix ~p filename =
   if p = 0 then
     filename
   else
-    match Lib.String.cuts '/' filename with
+    match String.split_on_char '/' filename with
     | [] -> assert false
     | x::xs ->
         (* Per GNU patch's spec: A sequence of one or more adjacent slashes is counted as a single slash. *)
@@ -479,7 +481,10 @@ let patch ~cleanly filedata diff =
       | _ -> assert false
     end
   | Edit _ ->
-    let old = match filedata with None -> Rope.empty | Some x -> Rope.of_string x in
+    let old = match filedata with
+      | None -> invalid_arg "no input file given on edition operation"
+      | Some x -> Rope.of_string x
+    in
     let _, _, rope = List.fold_left (apply_hunk ~cleanly ~fuzz:0) (0, 0, old) diff.hunks in
     let lines = Rope.to_string rope in
     let lines =

src/patch.mli

@@ -83,7 +83,9 @@ val parse : p:int -> string -> t list
 
 val patch : cleanly:bool -> string option -> t -> string option
 (** [patch file_contents diff] applies [diff] on [file_contents], resulting in
-    the new file contents (or None if deleted). *)
+    the new file contents (or None if deleted).
+
+    @raise Invalid_argument if file_contents is [None] but [diff.operation = Edit _] *)
 
 val diff : (string * string) option -> (string * string) option -> t option
 (** [diff (filename_a, content_a) (filename_b, content_b)] creates a diff between

src/rope.mli

@@ -3,9 +3,6 @@ type t (** The type for a rope data structure *)
 val length : t -> int
 (** [length t] returns the amount of strings in [t]. *)
 
-val empty : t
-(** [empty] is the empty rope. *)
-
 val of_strings : string list -> bool -> t
 (** [of_strings xs nl] is a rope [t] which contains the strings of [xs]. If
     [nl] is true, the last string will have a newline, otherwise not. *)