Skip to content

Commit 7f6368b

Browse files
azzsalazzsal
authored
Improve diff representation for variant types (#111)
* Add cram test for modified variant types * Add minimal diff representation for variant types and print them in Text_diff properly * Fix cram test * Add diffing of constructor argument * Fix diffing of modified record and variant types * Print text diffs of tuple constructor arguments -incomplete * Fix printing of text diff for variant types -incomplete * Fix diffing of constructor arguments, printing of their text diffs and update tests * Add changelog entry * Simplify diffing logic of tuple types * Fix printing of constructors with tuple arguments * Fix .ocamlformat * Minor fixes to the printing of type exprs * Minor refactor of typ_expr_to_line
1 parent c5c2976 commit 7f6368b

File tree

7 files changed

+544
-84
lines changed

7 files changed

+544
-84
lines changed

‎CHANGES.md‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -12,6 +12,7 @@
1212
### Changed
1313

1414
- Improve diff representation of modified record types (#109, @azzsal)
15+
- Improve diff representation of modified variant types (#111, @azzsal)
1516

1617
### Deprecated
1718

‎lib/diff.ml‎

Lines changed: 119 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -12,16 +12,30 @@ type value = {
1212
vdiff : (value_description, value_description atomic_modification) t;
1313
}
1414

15-
type type_modification =
16-
| Compound of record_field list
15+
type type_ = { tname : string; tdiff : (type_declaration, type_modification) t }
16+
17+
and type_modification =
18+
| Record_diff of record_field list
19+
| Variant_diff of constructor_ list
1720
| Atomic of type_declaration atomic_modification
1821

1922
and record_field = {
20-
lname : string;
21-
ldiff : (label_declaration, label_declaration atomic_modification) t;
23+
rname : string;
24+
rdiff : (label_declaration, label_declaration atomic_modification) t;
2225
}
2326

24-
type type_ = { tname : string; tdiff : (type_declaration, type_modification) t }
27+
and constructor_ = {
28+
csname : string;
29+
csdiff : (constructor_declaration, constructor_modification) t;
30+
}
31+
32+
and constructor_modification =
33+
| Record_c of record_field list
34+
| Tuple_c of tuple_component list
35+
| Atomic_c of constructor_declaration atomic_modification
36+
37+
and tuple_component =
38+
(type_expr, (type_expr, type_expr atomic_modification) t) Either.t
2539

2640
type class_ = {
2741
cname : string;
@@ -103,6 +117,11 @@ let extract_lbls lbls =
103117
(fun map lbl -> String_map.add (Ident.name lbl.ld_id) lbl map)
104118
String_map.empty lbls
105119

120+
let extract_cstrs cstrs =
121+
List.fold_left
122+
(fun map cstr -> String_map.add (Ident.name cstr.cd_id) cstr map)
123+
String_map.empty cstrs
124+
106125
let rec type_item ~typing_env ~name ~reference ~current =
107126
match (reference, current) with
108127
| None, None -> None
@@ -123,37 +142,123 @@ let rec type_item ~typing_env ~name ~reference ~current =
123142
| None, None -> None
124143
| _, _ -> (
125144
match (reference.type_kind, current.type_kind) with
126-
| Type_record (ref_label_lst, _), Type_record (cur_label_lst, _) ->
145+
| Type_record (ref_label_lst, _), Type_record (cur_label_lst, _) -> (
127146
let changed_lbls =
128147
modified_record_type ~typing_env ~ref_label_lst ~cur_label_lst
129148
in
130-
Some
131-
(Type { tname = name; tdiff = Modified (Compound changed_lbls) })
132-
| _, _ ->
149+
match changed_lbls with
150+
| [] -> None
151+
| _ ->
152+
Some
153+
(Type
154+
{
155+
tname = name;
156+
tdiff = Modified (Record_diff changed_lbls);
157+
}))
158+
| ( Type_variant (ref_constructor_lst, _),
159+
Type_variant (cur_constructor_lst, _) ) -> (
160+
let changed_constrs =
161+
modified_variant_type ~typing_env ~ref_constructor_lst
162+
~cur_constructor_lst
163+
in
164+
match changed_constrs with
165+
| [] -> None
166+
| _ ->
167+
Some
168+
(Type
169+
{
170+
tname = name;
171+
tdiff = Modified (Variant_diff changed_constrs);
172+
}))
173+
| _ ->
133174
Some
134175
(Type
135176
{
136177
tname = name;
137178
tdiff = Modified (Atomic { reference; current });
138179
})))
139180

140-
and modified_record_type ~typing_env ~ref_label_lst ~cur_label_lst =
181+
and modified_variant_type ~typing_env ~ref_constructor_lst ~cur_constructor_lst
182+
=
183+
let diff_cstrs name cstr1 cstr2 =
184+
match (cstr1.cd_args, cstr2.cd_args) with
185+
| Cstr_tuple type_lst1, Cstr_tuple type_lst2 ->
186+
let tuple_diff = modified_tuple_type ~typing_env type_lst1 type_lst2 in
187+
if
188+
List.for_all
189+
(fun t ->
190+
match t with Either.Left _ -> true | Either.Right _ -> false)
191+
tuple_diff
192+
then None
193+
else Some { csname = name; csdiff = Modified (Tuple_c tuple_diff) }
194+
| Cstr_record ref_label_lst, Cstr_record cur_label_lst ->
195+
let record_diff =
196+
modified_record_type ~typing_env ~ref_label_lst ~cur_label_lst
197+
in
198+
if List.length record_diff = 0 then None
199+
else Some { csname = name; csdiff = Modified (Record_c record_diff) }
200+
| _ ->
201+
Some
202+
{
203+
csname = name;
204+
csdiff = Modified (Atomic_c { reference = cstr1; current = cstr2 });
205+
}
206+
in
207+
let ref_cstrs = extract_cstrs ref_constructor_lst in
208+
let curr_cstrs = extract_cstrs cur_constructor_lst in
209+
let modified_cstrs =
210+
String_map.merge
211+
(fun name ref cur ->
212+
match (ref, cur) with
213+
| None, None -> None
214+
| Some ref, None -> Some { csname = name; csdiff = Removed ref }
215+
| None, Some cur -> Some { csname = name; csdiff = Added cur }
216+
| Some ref, Some cur -> diff_cstrs name ref cur)
217+
ref_cstrs curr_cstrs
218+
|> String_map.bindings |> List.map snd
219+
in
220+
modified_cstrs
221+
222+
and diff_list (diff_one : 'a option -> 'a option -> ('a, 'diff) Either.t)
223+
(ref : 'a list) (curr : 'a list) : ('a, 'diff) Either.t list =
224+
match (ref, curr) with
225+
| [], [] -> []
226+
| h1 :: t1, [] -> diff_one (Some h1) None :: diff_list diff_one t1 []
227+
| [], h2 :: t2 -> diff_one None (Some h2) :: diff_list diff_one [] t2
228+
| h1 :: t1, h2 :: t2 ->
229+
diff_one (Some h1) (Some h2) :: diff_list diff_one t1 t2
230+
231+
and modified_tuple_type ~typing_env (ref_tuple : type_expr list)
232+
(cur_tuple : type_expr list) : tuple_component list =
233+
diff_list
234+
(fun t1 t2 ->
235+
match (t1, t2) with
236+
| None, None -> assert false
237+
| Some t1, None -> Either.right (Removed t1)
238+
| None, Some t2 -> Either.right (Added t2)
239+
| Some t1, Some t2 ->
240+
if Ctype.does_match typing_env t1 t2 then Either.left t1
241+
else Either.right (Modified { reference = t1; current = t2 }))
242+
ref_tuple cur_tuple
243+
244+
and modified_record_type ~typing_env ~(ref_label_lst : label_declaration list)
245+
~(cur_label_lst : label_declaration list) =
141246
let ref_lbls = extract_lbls ref_label_lst in
142247
let curr_lbls = extract_lbls cur_label_lst in
143248
let changed_lbls =
144249
String_map.merge
145250
(fun name ref cur ->
146251
match (ref, cur) with
147252
| None, None -> None
148-
| Some ref, None -> Some { lname = name; ldiff = Removed ref }
149-
| None, Some cur -> Some { lname = name; ldiff = Added cur }
253+
| Some ref, None -> Some { rname = name; rdiff = Removed ref }
254+
| None, Some cur -> Some { rname = name; rdiff = Added cur }
150255
| Some ref, Some cur ->
151256
if Ctype.does_match typing_env ref.ld_type cur.ld_type then None
152257
else
153258
Some
154259
{
155-
lname = name;
156-
ldiff = Modified { reference = ref; current = cur };
260+
rname = name;
261+
rdiff = Modified { reference = ref; current = cur };
157262
})
158263
ref_lbls curr_lbls
159264
|> String_map.bindings |> List.map snd

‎lib/diff.mli‎

Lines changed: 32 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -7,7 +7,38 @@ type value = {
77
(Types.value_description, Types.value_description atomic_modification) t;
88
}
99

10-
and class_ = {
10+
type type_ = {
11+
tname : string;
12+
tdiff : (Types.type_declaration, type_modification) t;
13+
}
14+
15+
and type_modification =
16+
| Record_diff of record_field list
17+
| Variant_diff of constructor_ list
18+
| Atomic of Types.type_declaration atomic_modification
19+
20+
and record_field = {
21+
rname : string;
22+
rdiff :
23+
(Types.label_declaration, Types.label_declaration atomic_modification) t;
24+
}
25+
26+
and constructor_ = {
27+
csname : string;
28+
csdiff : (Types.constructor_declaration, constructor_modification) t;
29+
}
30+
31+
and constructor_modification =
32+
| Record_c of record_field list
33+
| Tuple_c of tuple_component list
34+
| Atomic_c of Types.constructor_declaration atomic_modification
35+
36+
and tuple_component =
37+
( Types.type_expr,
38+
(Types.type_expr, Types.type_expr atomic_modification) t )
39+
Either.t
40+
41+
type class_ = {
1142
cname : string;
1243
cdiff :
1344
(Types.class_declaration, Types.class_declaration atomic_modification) t;
@@ -21,21 +52,6 @@ and cltype = {
2152
t;
2253
}
2354

24-
type type_modification =
25-
| Compound of record_field list
26-
| Atomic of Types.type_declaration atomic_modification
27-
28-
and record_field = {
29-
lname : string;
30-
ldiff :
31-
(Types.label_declaration, Types.label_declaration atomic_modification) t;
32-
}
33-
34-
type type_ = {
35-
tname : string;
36-
tdiff : (Types.type_declaration, type_modification) t;
37-
}
38-
3955
type module_ = {
4056
mname : string;
4157
mdiff : (Types.module_declaration, signature_modification) t;

0 commit comments

Comments
 (0)