1 (** Line-oriented diffs between two blobs. 2 3 Computes a Myers diff — the greedy O(ND) algorithm from "An O(ND) 4 Difference Algorithm and Its Variations" (Myers, 1986), the same algorithm 5 [git diff] uses by default — and groups the result into hunks with the 6 surrounding context. Cost scales with the number of differences, not with 7 file size, so a small change in a large file is cheap. When two files 8 differ in more than [max_differences] lines after trimming their common 9 prefix and suffix, the diff falls back to listing every remaining old line 10 as deleted followed by every remaining new line as added. 11 12 The module is named for the granularity it works at: whole lines, matched as 13 opaque units, with no word- or character-level refinement. 14 15 It produces data only. Rendering it is {!module:Ui.Diff}'s job. *) 16 17 type line_kind = Context | Addition | Deletion 18 19 type line = { 20 kind : line_kind; 21 old_number : int option; 22 new_number : int option; 23 text : string; 24 } 25 26 type hunk = { 27 old_start : int; 28 old_count : int; 29 new_start : int; 30 new_count : int; 31 lines : line list; 32 } 33 34 type file = { 35 path : string; 36 old_hash : string option; 37 new_hash : string option; 38 old_mode : int option; 39 new_mode : int option; 40 binary : bool; 41 hunks : hunk list; 42 } 43 44 let split_lines content = 45 match String.split_on_char '\n' content with 46 | [] -> [] 47 | lines -> 48 if content = "" then [] 49 else if String.ends_with ~suffix:"\n" content then 50 List.rev lines |> List.tl |> List.rev 51 else lines 52 53 (* The cap on the edit distance D the search explores. The backtracking trace 54 grows as D² words — about 8 MB at this cap — and the forward pass costs 55 O((N+M)·D), so the cap bounds both for pathological pairs. A commit that 56 changes over a thousand lines in one file (after prefix/suffix trimming) 57 degrades to all-deletions-then-all-additions rather than failing. *) 58 let max_differences = 1_024 59 60 (* One edit-script step over the trimmed middle of the two files. *) 61 type edit = Keep | Delete | Insert 62 63 (* Myers' greedy shortest-edit-script search over two int arrays (lines are 64 interned before the search, so equality is an integer compare). 65 66 Variables follow the paper so the code can be checked against it: the edit 67 graph runs from (0, 0) to (n, m), [d] is the edit distance explored so far, 68 [k = x - y] indexes diagonals, and [v] holds, per diagonal, the furthest x 69 reached. Each round snapshots the slice of [v] its backtrack step needs 70 (diagonals -(d+1)..d+1), so trace memory is O(D²) rather than O(D·(N+M)). 71 72 Returns the edit script in order, or [None] when the files differ in more 73 than [max_differences] lines. *) 74 let myers old_ids new_ids = 75 let n = Array.length old_ids and m = Array.length new_ids in 76 let bound = min (n + m) max_differences in 77 let offset = bound + 1 in 78 let v = Array.make ((2 * bound) + 3) 0 in 79 let trace = ref [] in 80 let exception Found of int in 81 let found_d = 82 try 83 for d = 0 to bound do 84 let slice = 85 Array.init ((2 * d) + 3) (fun i -> v.(i - (d + 1) + offset)) 86 in 87 trace := slice :: !trace; 88 let k = ref (-d) in 89 while !k <= d do 90 let start_x = 91 if 92 !k = -d 93 || (!k <> d && v.(!k - 1 + offset) < v.(!k + 1 + offset)) 94 then v.(!k + 1 + offset) 95 else v.(!k - 1 + offset) + 1 96 in 97 let x = ref start_x in 98 let y = ref (start_x - !k) in 99 while !x < n && !y < m && old_ids.(!x) = new_ids.(!y) do 100 incr x; 101 incr y 102 done; 103 v.(!k + offset) <- !x; 104 if !x >= n && !y >= m then raise (Found d); 105 k := !k + 2 106 done 107 done; 108 None 109 with Found d -> Some d 110 in 111 match found_d with 112 | None -> None 113 | Some found_d -> 114 (* Walk back from (n, m), reading each round's snapshot to find where 115 the path entered it: a vertical step is an insertion, a horizontal 116 step a deletion, and the diagonal run before it is kept lines. *) 117 let edits = ref [] in 118 let x = ref n and y = ref m in 119 let rec go d = function 120 | [] -> () 121 | slice :: earlier -> 122 let slice_offset = d + 1 in 123 let k = !x - !y in 124 let previous_k = 125 if 126 k = -d 127 || (k <> d 128 && slice.(k - 1 + slice_offset) 129 < slice.(k + 1 + slice_offset)) 130 then k + 1 131 else k - 1 132 in 133 let previous_x = slice.(previous_k + slice_offset) in 134 let previous_y = previous_x - previous_k in 135 while !x > previous_x && !y > previous_y do 136 edits := Keep :: !edits; 137 decr x; 138 decr y 139 done; 140 if d > 0 then 141 edits := (if !x = previous_x then Insert else Delete) :: !edits; 142 x := previous_x; 143 y := previous_y; 144 go (d - 1) earlier 145 in 146 go found_d !trace; 147 Some !edits 148 149 let of_contents old_content new_content = 150 let old_lines = Array.of_list (split_lines old_content) in 151 let new_lines = Array.of_list (split_lines new_content) in 152 let old_length = Array.length old_lines in 153 let new_length = Array.length new_lines in 154 (* Trim the common prefix and suffix before searching: they are context by 155 definition, and the difference cap should apply to what actually 156 differs. *) 157 let prefix = ref 0 in 158 while 159 !prefix < old_length 160 && !prefix < new_length 161 && old_lines.(!prefix) = new_lines.(!prefix) 162 do 163 incr prefix 164 done; 165 let prefix = !prefix in 166 let suffix = ref 0 in 167 while 168 !suffix < old_length - prefix 169 && !suffix < new_length - prefix 170 && old_lines.(old_length - 1 - !suffix) = new_lines.(new_length - 1 - !suffix) 171 do 172 incr suffix 173 done; 174 let suffix = !suffix in 175 let middle_old = old_length - prefix - suffix in 176 let middle_new = new_length - prefix - suffix in 177 (* Intern the middle lines so the search compares integers, not strings. *) 178 let ids = Hashtbl.create 64 in 179 let next_id = ref 0 in 180 let id_of line = 181 match Hashtbl.find_opt ids line with 182 | Some id -> id 183 | None -> 184 let id = !next_id in 185 incr next_id; 186 Hashtbl.add ids line id; 187 id 188 in 189 let old_ids = Array.init middle_old (fun i -> id_of old_lines.(prefix + i)) in 190 let new_ids = Array.init middle_new (fun i -> id_of new_lines.(prefix + i)) in 191 let edits = 192 match myers old_ids new_ids with 193 | Some edits -> edits 194 | None -> 195 (* Too many differences: list the middle as wholesale replacement. *) 196 List.init middle_old (fun _ -> Delete) 197 @ List.init middle_new (fun _ -> Insert) 198 in 199 (* Reassemble: prefix context, the edit script over the middle, suffix 200 context, numbering lines in each file as we go. *) 201 let context index = 202 { 203 kind = Context; 204 old_number = Some (index + 1); 205 new_number = Some (index + 1); 206 text = old_lines.(index); 207 } 208 in 209 let prefix_lines = List.init prefix context in 210 let old_index = ref prefix and new_index = ref prefix in 211 let middle_lines = 212 List.map 213 (fun edit -> 214 match edit with 215 | Keep -> 216 let line = 217 { 218 kind = Context; 219 old_number = Some (!old_index + 1); 220 new_number = Some (!new_index + 1); 221 text = old_lines.(!old_index); 222 } 223 in 224 incr old_index; 225 incr new_index; 226 line 227 | Delete -> 228 let line = 229 { 230 kind = Deletion; 231 old_number = Some (!old_index + 1); 232 new_number = None; 233 text = old_lines.(!old_index); 234 } 235 in 236 incr old_index; 237 line 238 | Insert -> 239 let line = 240 { 241 kind = Addition; 242 old_number = None; 243 new_number = Some (!new_index + 1); 244 text = new_lines.(!new_index); 245 } 246 in 247 incr new_index; 248 line) 249 edits 250 in 251 let suffix_lines = 252 List.init suffix (fun i -> 253 { 254 kind = Context; 255 old_number = Some (old_length - suffix + i + 1); 256 new_number = Some (new_length - suffix + i + 1); 257 text = old_lines.(old_length - suffix + i); 258 }) 259 in 260 prefix_lines @ middle_lines @ suffix_lines 261 262 let hunks ?(context = 3) lines = 263 let lines = Array.of_list lines in 264 let length = Array.length lines in 265 let changed = 266 Array.to_list (Array.mapi (fun index line -> (index, line.kind)) lines) 267 |> List.filter_map (function 268 | index, (Addition | Deletion) -> Some index 269 | _, Context -> None) 270 in 271 let ranges = 272 let add_range ranges index = 273 let first = max 0 (index - context) in 274 let last = min (length - 1) (index + context) in 275 match ranges with 276 | (range_first, range_last) :: rest when first <= range_last + 1 -> 277 (range_first, max range_last last) :: rest 278 | _ -> (first, last) :: ranges 279 in 280 List.fold_left add_range [] changed |> List.rev 281 in 282 let number_or_zero get_number slice = 283 List.find_map get_number slice |> Option.value ~default:0 284 in 285 let make_hunk (first, last) = 286 let rec slice index acc = 287 if index > last then List.rev acc 288 else slice (index + 1) (lines.(index) :: acc) 289 in 290 let lines = slice first [] in 291 { 292 old_start = number_or_zero (fun line -> line.old_number) lines; 293 old_count = 294 List.fold_left 295 (fun count line -> 296 if Option.is_some line.old_number then count + 1 else count) 297 0 lines; 298 new_start = number_or_zero (fun line -> line.new_number) lines; 299 new_count = 300 List.fold_left 301 (fun count line -> 302 if Option.is_some line.new_number then count + 1 else count) 303 0 lines; 304 lines; 305 } 306 in 307 List.map make_hunk ranges 308