From 9daa35678cdfa3e063285f02dc51ecfa72cebf27 Mon Sep 17 00:00:00 2001 From: Kate Date: Sat, 19 Apr 2025 01:24:55 +0100 Subject: [PATCH 1/6] Speedup Lib functions and remove slow and unnecessary Lib.String.cuts --- src/lib.ml | 59 +++++++++++++++++++++++++++++++--------------------- src/lib.mli | 1 - src/patch.ml | 4 ++-- 3 files changed, 37 insertions(+), 27 deletions(-) diff --git a/src/lib.ml b/src/lib.ml index 95b496f..9e44f8c 100644 --- a/src/lib.ml +++ b/src/lib.ml @@ -1,35 +1,46 @@ 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 String.unsafe_get str i = + (String.unsafe_get prefix i : char) 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 String.unsafe_get str str_i = + (String.unsafe_get suffix suffix_i : char) 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 diff --git a/src/lib.mli b/src/lib.mli index fe6d438..28076e1 100644 --- a/src/lib.mli +++ b/src/lib.mli @@ -2,7 +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 diff --git a/src/patch.ml b/src/patch.ml index e5c66e2..1d72ea7 100644 --- a/src/patch.ml +++ b/src/patch.ml @@ -127,7 +127,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 @@ -333,7 +333,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. *) From 3498af3fabe1c6525d5ee4d83a6e8d936f6f9b36 Mon Sep 17 00:00:00 2001 From: Kate Date: Mon, 21 Apr 2025 17:48:39 +0100 Subject: [PATCH 2/6] raise invalid argument on patch edit if filedata is None --- src/patch.ml | 5 ++++- src/patch.mli | 4 +++- src/rope.mli | 3 --- 3 files changed, 7 insertions(+), 5 deletions(-) diff --git a/src/patch.ml b/src/patch.ml index 1d72ea7..71cd4c8 100644 --- a/src/patch.ml +++ b/src/patch.ml @@ -479,7 +479,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 = diff --git a/src/patch.mli b/src/patch.mli index b04200f..3c174ac 100644 --- a/src/patch.mli +++ b/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 diff --git a/src/rope.mli b/src/rope.mli index e34c281..9decc8c 100644 --- a/src/rope.mli +++ b/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. *) From 8b641f6c4ad54e054fd629440748e90897c68587 Mon Sep 17 00:00:00 2001 From: Kate Date: Mon, 21 Apr 2025 22:11:56 +0100 Subject: [PATCH 3/6] Speedup Patch.patch by removing unnessecary Lib.List.last --- src/lib.ml | 7 ------- src/lib.mli | 4 ---- src/patch.ml | 8 +++++--- 3 files changed, 5 insertions(+), 14 deletions(-) diff --git a/src/lib.ml b/src/lib.ml index 9e44f8c..0c59f90 100644 --- a/src/lib.ml +++ b/src/lib.ml @@ -62,10 +62,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 diff --git a/src/lib.mli b/src/lib.mli index 28076e1..9e73ba1 100644 --- a/src/lib.mli +++ b/src/lib.mli @@ -5,7 +5,3 @@ module String : sig 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 diff --git a/src/patch.ml b/src/patch.ml index 71cd4c8..ed360ae 100644 --- a/src/patch.ml +++ b/src/patch.ml @@ -86,14 +86,16 @@ 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 List.hd rev_mine = (List.hd rev_their : string) 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 From 4f3d6c1f566a33534704241935b1810db3acb72c Mon Sep 17 00:00:00 2001 From: Kate Date: Mon, 21 Apr 2025 22:13:48 +0100 Subject: [PATCH 4/6] Slightly speedup various functions by using String.unsafe_get instead of String.get --- src/patch.ml | 50 +++++++++++++++++++++++++------------------------- 1 file changed, 25 insertions(+), 25 deletions(-) diff --git a/src/patch.ml b/src/patch.ml index ed360ae..4dac807 100644 --- a/src/patch.ml +++ b/src/patch.ml @@ -149,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 -> @@ -248,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 From 92e0ac1c69b16fe3cac0f023d662969a16f194a1 Mon Sep 17 00:00:00 2001 From: Kate Date: Mon, 21 Apr 2025 22:17:36 +0100 Subject: [PATCH 5/6] Replace Format.pp_print_text by the faster Format.pp_print_string --- src/patch.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/patch.ml b/src/patch.ml index 4dac807..e8cd08e 100644 --- a/src/patch.ml +++ b/src/patch.ml @@ -282,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) -> From f28c06739c7343ec2b6ae57767ac1d4a1f22a293 Mon Sep 17 00:00:00 2001 From: Kate Date: Mon, 22 Dec 2025 21:38:28 +0000 Subject: [PATCH 6/6] Replace the 'x = (y : type)' pattern by 'Type.equal x y' --- src/lib.ml | 14 +++++++++----- src/patch.ml | 6 +++--- 2 files changed, 12 insertions(+), 8 deletions(-) diff --git a/src/lib.ml b/src/lib.ml index 0c59f90..01c972d 100644 --- a/src/lib.ml +++ b/src/lib.ml @@ -2,8 +2,9 @@ module String = struct let is_prefix ~prefix str = let rec aux i ~prefix_len ~prefix ~str = if i < (prefix_len : int) then - if String.unsafe_get str i = - (String.unsafe_get prefix i : char) then + if Char.equal + (String.unsafe_get str i) + (String.unsafe_get prefix i) then aux (i + 1) ~prefix_len ~prefix ~str else false @@ -19,8 +20,9 @@ module String = struct let is_suffix ~suffix str = let rec aux suffix_i str_i ~suffix_len ~suffix ~str = if suffix_i < (suffix_len : int) then - if String.unsafe_get str str_i = - (String.unsafe_get suffix suffix_i : char) 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 @@ -53,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 diff --git a/src/patch.ml b/src/patch.ml index e8cd08e..8b15f27 100644 --- a/src/patch.ml +++ b/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; @@ -88,7 +88,7 @@ let rec apply_hunk ~cleanly ~fuzz (last_matched_line, offset, rope) ({mine_start let hunk = let rev_mine = List.rev hunk.mine in let rev_their = List.rev hunk.their in - if List.hd rev_mine = (List.hd rev_their : string) then + if String.equal (List.hd rev_mine) (List.hd rev_their) then { mine_start = hunk.mine_start; mine_len = hunk.mine_len - 1; @@ -102,7 +102,7 @@ let rec apply_hunk ~cleanly ~fuzz (last_matched_line, offset, rope) ({mine_start 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