1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
module type Equal = sig
type t
val equal : t -> t -> bool
end
module Line = struct
type 'a t = Delete of 'a | Insert of 'a | Keep of 'a
end
exception Found of int * int array list
let compute (type a) (module Equal : Equal with type t = a) (before : a list)
(after : a list) =
let a = Array.of_list before in
let b = Array.of_list after in
let n = Array.length a in
let m = Array.length b in
let max_d = n + m in
if max_d = 0 then []
else
let offset = max_d in
let v = Array.make ((2 * max_d) + 1) (-1) in
v.(offset + 1) <- 0;
let traces_rev = ref [] in
try
for d = 0 to max_d do
for k = -d to d do
if (k + d) mod 2 = 0 then begin
let x =
if k = -d || (k <> d && v.(offset + k - 1) < v.(offset + k + 1))
then v.(offset + k + 1)
else if k = d then v.(offset + k - 1) + 1
else
let x1 = v.(offset + k - 1) + 1 in
let x2 = v.(offset + k + 1) in
if x1 > x2 then x1 else x2
in
let y = x - k in
let x, y =
let x = ref x in
let y = ref y in
while !x < n && !y < m && Equal.equal a.(!x) b.(!y) do
incr x;
incr y
done;
(!x, !y)
in
v.(offset + k) <- x;
if x >= n && y >= m then begin
traces_rev := Array.copy v :: !traces_rev;
raise (Found (d, List.rev !traces_rev))
end
end
done;
traces_rev := Array.copy v :: !traces_rev
done;
[]
with Found (d_final, traces) ->
let traces = Array.of_list traces in
let x = ref n in
let y = ref m in
let ops = ref [] in
for d = d_final downto 1 do
let k = !x - !y in
let prev = traces.(d - 1) in
let prev_k =
if k = -d || (k <> d && prev.(offset + k - 1) < prev.(offset + k + 1))
then k + 1
else k - 1
in
let prev_x = prev.(offset + prev_k) in
let prev_y = prev_x - prev_k in
while !x > prev_x && !y > prev_y do
ops := Line.Keep a.(!x - 1) :: !ops;
decr x;
decr y
done;
if prev_k = k + 1 then ops := Line.Insert b.(prev_y) :: !ops
else ops := Line.Delete a.(prev_x) :: !ops;
x := prev_x;
y := prev_y
done;
while !x > 0 && !y > 0 do
ops := Line.Keep a.(!x - 1) :: !ops;
decr x;
decr y
done;
while !x > 0 do
ops := Line.Delete a.(!x - 1) :: !ops;
decr x
done;
while !y > 0 do
ops := Line.Insert b.(!y - 1) :: !ops;
decr y
done;
!ops
type hunk = {
exp_start : int;
exp_len : int;
act_start : int;
act_len : int;
lines : (char * string) list;
}
let lines_of_string s =
let parts = String.split_on_char '\n' s in
match List.rev parts with
| "" :: rev_rest -> Array.of_list (List.rev rev_rest)
| _ -> Array.of_list parts
let hunks_of_lines ~context expected actual =
let module Eq = struct
type t = string
let equal = String.equal
end in
let ops =
compute (module Eq) (Array.to_list expected) (Array.to_list actual)
in
let pre = Queue.create () in
let hunks_rev = ref [] in
let in_hunk = ref false in
let trailing = ref 0 in
let cur_lines_rev = ref [] in
let cur_exp_start = ref 0 in
let cur_act_start = ref 0 in
let cur_exp_len = ref 0 in
let cur_act_len = ref 0 in
let exp_line = ref 1 in
let act_line = ref 1 in
let queue_trim () =
while Queue.length pre > context do
ignore (Queue.take pre)
done
in
let queue_to_list () =
let acc = ref [] in
Queue.iter (fun x -> acc := x :: !acc) pre;
List.rev !acc
in
let start_hunk () =
in_hunk := true;
let pre_lines = queue_to_list () in
Queue.clear pre;
cur_lines_rev := List.rev_map (fun l -> (' ', l)) pre_lines;
cur_exp_start := !exp_line - List.length pre_lines;
cur_act_start := !act_line - List.length pre_lines;
cur_exp_len := List.length pre_lines;
cur_act_len := List.length pre_lines;
trailing := 0
in
let finish_hunk () =
if !in_hunk then begin
let h =
{
exp_start = !cur_exp_start;
exp_len = !cur_exp_len;
act_start = !cur_act_start;
act_len = !cur_act_len;
lines = List.rev !cur_lines_rev;
}
in
hunks_rev := h :: !hunks_rev;
cur_lines_rev := [];
in_hunk := false;
trailing := 0
end
in
let add_hunk_line prefix line =
cur_lines_rev := (prefix, line) :: !cur_lines_rev;
match prefix with
| ' ' ->
cur_exp_len := !cur_exp_len + 1;
cur_act_len := !cur_act_len + 1
| '-' -> cur_exp_len := !cur_exp_len + 1
| '+' -> cur_act_len := !cur_act_len + 1
| _ -> ()
in
List.iter
(function
| Line.Keep line ->
if !in_hunk then begin
if !trailing > 0 then begin
add_hunk_line ' ' line;
trailing := !trailing - 1
end
else begin
finish_hunk ();
Queue.add line pre;
queue_trim ()
end
end
else begin
Queue.add line pre;
queue_trim ()
end;
exp_line := !exp_line + 1;
act_line := !act_line + 1
| Line.Delete line ->
if not !in_hunk then start_hunk ();
add_hunk_line '-' line;
trailing := context;
exp_line := !exp_line + 1
| Line.Insert line ->
if not !in_hunk then start_hunk ();
add_hunk_line '+' line;
trailing := context;
act_line := !act_line + 1)
ops;
finish_hunk ();
List.rev !hunks_rev
let diff ?(context = 3) ?(expected_label = "expected")
?(actual_label = "actual") expected actual =
let a = lines_of_string expected in
let b = lines_of_string actual in
let hunks = hunks_of_lines ~context a b in
let buf = Buffer.create 2048 in
Buffer.add_string buf
(Printf.sprintf "--- %s\n+++ %s\n" expected_label actual_label);
let output_line (p, line) =
Buffer.add_string buf (Printf.sprintf "%c %s\n" p line)
in
let flush_changes dels adds =
List.iter output_line (List.rev dels);
List.iter output_line (List.rev adds)
in
List.iter
(fun h ->
Buffer.add_string buf
(Printf.sprintf "@@ -%d,%d +%d,%d @@\n" h.exp_start h.exp_len
h.act_start h.act_len);
let dels = ref [] in
let adds = ref [] in
List.iter
(fun ((p, _) as line) ->
match p with
| '-' -> dels := line :: !dels
| '+' -> adds := line :: !adds
| _ ->
flush_changes !dels !adds;
dels := [];
adds := [];
output_line line)
h.lines;
flush_changes !dels !adds)
hunks;
Buffer.contents buf
let print_diff ?context ?expected_label ?actual_label expected actual =
let text = diff ?context ?expected_label ?actual_label expected actual in
print_string text