Use a rope of string array instead of a list of strings

src/dune

@@ -2,7 +2,7 @@
  (name patch)
  (synopsis "Patch purely in OCaml")
  (public_name patch)
- (modules patch lib fname))
+ (modules patch lib fname rope))
 
 (executable
  (name patch_command)

src/patch.ml

@@ -36,27 +36,29 @@ let pp_hunk ~mine_no_nl ~their_no_nl ppf hunk =
     hunk.mine_start hunk.mine_len hunk.their_start hunk.their_len
     (unified_diff ~mine_no_nl ~their_no_nl hunk)
 
-let rec apply_hunk ~cleanly ~fuzz (last_matched_line, offset, lines) ({mine_start; mine_len; mine; their_start = _; their_len; their} as hunk) =
+let rec apply_hunk ~cleanly ~fuzz (last_matched_line, offset, rope) ({mine_start; mine_len; mine; their_start = _; their_len; their} as hunk) =
   let mine_start = mine_start + offset in
   let patch_match ~search_offset =
     let mine_start = mine_start + search_offset in
-    let rev_prefix, rest = Lib.List.rev_cut (Stdlib.max 0 (mine_start - 1)) lines in
-    let rev_actual_mine, suffix = Lib.List.rev_cut mine_len rest in
-    let actual_mine = List.rev rev_actual_mine in
-    if actual_mine <> (mine : string list) then
-      invalid_arg "unequal mine";
-    (* TODO: should we check their_len against List.length their? *)
+    let prefix = Rope.chop rope (Stdlib.max 0 (mine_start - 1)) in
+    let actual_mine = Rope.chop rope ~off:(Stdlib.max 0 (mine_start - 1)) mine_len in
+    let off = Stdlib.max 0 (mine_start - 1) + mine_len in
+    let suffix = Rope.shift rope off in
+    if Rope.to_strings actual_mine <> mine then
+       invalid_arg "unequal mine";
+    let theirs =
+      let nl = Rope.last_is_nl actual_mine in
+      Rope.of_strings their nl
+    in
     (mine_start + mine_len, offset + (their_len - mine_len),
-     (* TODO: Replace rev_append (rev ...) by the tail-rec when patch
-        requires OCaml >= 4.14 *)
-     List.rev_append rev_prefix (List.rev_append (List.rev their) suffix))
+     Rope.concat prefix (Rope.concat theirs suffix))
   in
   try patch_match ~search_offset:0
   with Invalid_argument _ ->
     if cleanly then
       invalid_arg "apply_hunk"
     else
-      let max_pos_offset = Stdlib.max 0 (List.length lines - Stdlib.max 0 (mine_start - 1) - mine_len) in
+      let max_pos_offset = Stdlib.max 0 (Rope.length rope - Stdlib.max 0 (mine_start - 1) - mine_len) in
       let max_neg_offset = mine_start - last_matched_line in
       let rec locate search_offset =
         let aux search_offset max_offset =
@@ -100,7 +102,7 @@ let rec apply_hunk ~cleanly ~fuzz (last_matched_line, offset, lines) ({mine_star
             else if mine_len = (hunk.mine_len : int) && their_len = (hunk.their_len : int) then
               invalid_arg "apply_hunk: could not apply fuzz"
             else
-              apply_hunk ~cleanly ~fuzz:(fuzz + 1) (last_matched_line, offset, lines) hunk
+              apply_hunk ~cleanly ~fuzz:(fuzz + 1) (last_matched_line, offset, rope) hunk
           else
             invalid_arg "apply_hunk"
         else
@@ -476,9 +478,9 @@ let patch ~cleanly filedata diff =
       | _ -> assert false
     end
   | Edit _ ->
-    let old = match filedata with None -> [] | Some x -> to_lines x in
-    let _, _, lines = List.fold_left (apply_hunk ~cleanly ~fuzz:0) (0, 0, old) diff.hunks in
-    let lines = String.concat "\n" lines in
+    let old = match filedata with None -> Rope.empty | 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 =
       match diff.mine_no_nl, diff.their_no_nl with
       | false, true ->

src/rope.ml

@@ -0,0 +1,120 @@
+(* Originally from https://github.com/robur-coop/utcp, written by
+   Calascibetta Romain <[email protected]> *)
+
+(* A rope data structure where each node is a line *)
+
+type t =
+  | Str of string array * bool * int * int
+  | App of t * t * int * int
+
+let length = function
+  | Str (_, _, len, _) -> len
+  | App (_, _, len, _) -> len
+
+let height = function
+  | Str _ -> 0
+  | App (_, _, _, h) -> h
+
+(* keep compatibility with 4.08 *)
+let max_int (a : int) (b : int) = max a b
+let min_int (a : int) (b : int) = min a b
+external unsafe_blit_string : string -> int -> bytes -> int -> int -> unit
+  = "caml_blit_string" [@@noalloc]
+
+let append t1 t2 =
+  App (t1, t2, length t1 + length t2, 1 + max_int (height t1) (height t2))
+
+let empty = Str (Array.make 0 "", true, 0, 0)
+
+let rec unsafe_sub t start stop =
+  if start == 0 && stop = length t then
+    t
+  else if start == stop then
+    empty
+  else match t with
+    | Str (data, nl, len, off) ->
+      assert (stop <= len);
+      Str (data, nl, stop - start, off + start)
+    | App (l, r, _, _) ->
+        let len = length l in
+        if stop <= len then unsafe_sub l start stop
+        else if start >= len then unsafe_sub r (start - len) (stop - len)
+        else append (unsafe_sub l start len) (unsafe_sub r 0 (stop - len))
+
+let chop t ?(off = 0) len =
+  if len < 0 || len > length t - off
+  then invalid_arg "Rope.chop";
+  if len == 0 then empty else unsafe_sub t off (off + len)
+
+let shift t len =
+  if len < 0 then t
+  else if len == 0 then t
+  else
+    let max = length t in
+    let len = min_int max len in
+    let l = len + (max - len) in
+    unsafe_sub t len l
+
+let rec last_is_nl = function
+  | Str (a, nl, len, off) -> if Array.length a - off = len then nl else true
+  | App (_, r, _, _) -> last_is_nl r
+
+let rec byte_length = function
+  | Str (s, _, len, off) as a ->
+    let sum = ref 0 in
+    for idx = off to len + off - 1 do
+      let data = Array.unsafe_get s idx in
+      sum := !sum + String.length data + 1
+    done;
+    !sum - if last_is_nl a then 0 else 1
+  | App (l, r, _, _) -> byte_length l + byte_length r
+
+let rec into_bytes buf dst_off = function
+  | Str (s, _, len, off) as a ->
+    let off' = ref dst_off in
+    for idx = off to len + off - 1 do
+      let data = Array.unsafe_get s idx in
+      unsafe_blit_string data 0 buf !off' (String.length data);
+      off' := !off' + String.length data + 1;
+      if idx - off < len - 1 || (idx - off = len - 1 && last_is_nl a) then
+        Bytes.unsafe_set buf (!off' - 1) '\n'
+    done
+  | App (l, r, _, _) ->
+    into_bytes buf dst_off l;
+    into_bytes buf (dst_off + byte_length l) r
+
+let to_strings t =
+  let rec go acc = function
+    | Str (s, _nl, len, off) ->
+      let r = ref [] in
+      for idx = off to len + off - 1 do
+        let data = Array.unsafe_get s idx in
+        r := data :: !r
+      done;
+      List.rev_append !r acc
+    | App (l, r, _, _) -> go (go acc r) l in
+  go [] t
+
+let to_string t =
+  let len = byte_length t in
+  let buf = Bytes.create len in
+  into_bytes buf 0 t;
+  Bytes.unsafe_to_string buf
+
+let concat a b = append a b
+let prepend (str, nl) t = append (Str (Array.make 1 str, nl, 1, 0)) t
+
+let append t (str, nl) = append t (Str (Array.make 1 str, nl, 1, 0))
+
+let of_strings xs last_is_nl =
+  let d = Array.of_list xs in
+  Str (d, last_is_nl, Array.length d, 0)
+
+let of_string str =
+  let splitted = String.split_on_char '\n' str in
+  let last_is_nl = String.unsafe_get str (String.length str - 1) = '\n' in
+  let splitted = if last_is_nl then List.rev (List.tl (List.rev splitted)) else splitted in
+  let d = Array.of_list splitted in
+  Str (d, last_is_nl, Array.length d, 0)
+
+let equal a b = String.equal (to_string a) (to_string b)