| 1 | let same_traces (traces : ((Languages.ast * AST.trace) list)) = |
|---|
| 2 | let compare_trace trace1 trace2 = |
|---|
| 3 | let occs_trace1 = Misc.ListExt.multi_set_of_list trace1 |
|---|
| 4 | and occs_trace2 = Misc.ListExt.multi_set_of_list trace2 in |
|---|
| 5 | Misc.ListExt.assoc_diff occs_trace1 occs_trace2 |
|---|
| 6 | in |
|---|
| 7 | let check_trace (_, (_, trace1)) (_, (_, trace2)) = |
|---|
| 8 | compare_trace trace1 trace2 = [] |
|---|
| 9 | in |
|---|
| 10 | let print_trace lang1 lang2 ds = |
|---|
| 11 | let string_of_value = function |
|---|
| 12 | | None -> "is not present" |
|---|
| 13 | | Some v -> Printf.sprintf "appears %d times" v |
|---|
| 14 | in |
|---|
| 15 | let sentence (k, (v1, v2)) = |
|---|
| 16 | let k = CostLabel.string_of_cost_label ~pretty:true k in |
|---|
| 17 | Printf.sprintf " Label %s %s in language `%s' \ |
|---|
| 18 | whereas it %s in language `%s'." |
|---|
| 19 | k (string_of_value v1) lang1 (string_of_value v2) lang2 |
|---|
| 20 | in |
|---|
| 21 | String.concat "\n" (List.map sentence ds) |
|---|
| 22 | in |
|---|
| 23 | match Misc.ListExt.transitive_forall2 check_trace traces with |
|---|
| 24 | | None -> () |
|---|
| 25 | | Some ((ast1, (res1, trace1)), (ast2, (res2, trace2))) -> |
|---|
| 26 | let lang1 = Languages.to_string (Languages.language_of_ast ast1) |
|---|
| 27 | and lang2 = Languages.to_string (Languages.language_of_ast ast2) in |
|---|
| 28 | let diff = compare_trace trace1 trace2 in |
|---|
| 29 | Error.global_error "during trace comparison" |
|---|
| 30 | (Printf.sprintf |
|---|
| 31 | "The traces of two intermediate programs differ:\n%s" |
|---|
| 32 | (print_trace lang1 lang2 diff)) |
|---|
