From 64e848b2de171b3ac7f67eb86edab6b556038d61 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Georges=20Dup=C3=A9ron?= Date: Wed, 5 Jun 2019 11:48:33 +0200 Subject: [PATCH] structured errors for ast_typed/misc.ml --- src/ast_typed/misc.ml | 103 +++++++++++++++++++++++++++++++----------- 1 file changed, 77 insertions(+), 26 deletions(-) diff --git a/src/ast_typed/misc.ml b/src/ast_typed/misc.ml index 1094815df..53b03c2be 100644 --- a/src/ast_typed/misc.ml +++ b/src/ast_typed/misc.ml @@ -4,23 +4,39 @@ open Types module Errors = struct let different_kinds a b () = let title = (thunk "different kinds") in - let full () = Format.asprintf "(%a) VS (%a)" PP.type_value a PP.type_value b in - error title full () + let message () = "" in + let data = [ + ("a" , fun () -> Format.asprintf "(%a)" PP.type_value a) ; + ("b" , fun () -> Format.asprintf "(%a)" PP.type_value b ) + ] in + error ~data title message () let different_constants a b () = let title = (thunk "different constants") in - let full () = Format.asprintf "%s VS %s" a b in - error title full () + let message () = "" in + let data = [ + ("a" , fun () -> Format.asprintf "(%s)" a) ; + ("b" , fun () -> Format.asprintf "(%s)" b ) + ] in + error ~data title message () let different_size_type name a b () = let title () = name ^ " have different sizes" in - let full () = Format.asprintf "%a VS %a" PP.type_value a PP.type_value b in - error title full () + let message () = "" in + let data = [ + ("a" , fun () -> Format.asprintf "(%a)" PP.type_value a) ; + ("b" , fun () -> Format.asprintf "(%a)" PP.type_value b ) + ] in + error ~data title message () let different_props_in_record ka kb () = let title () = "different keys in record" in - let content () = Format.asprintf "%s vs %s" ka kb in - error title content () + let message () = "" in + let data = [ + ("key_a" , fun () -> Format.asprintf "(%s)" ka) ; + ("key_b" , fun () -> Format.asprintf "(%s)" kb ) + ] in + error ~data title message () let different_size_constants = different_size_type "constants" @@ -32,48 +48,83 @@ module Errors = struct let different_types name a b () = let title () = name ^ " are different" in - let full () = Format.asprintf "%a VS %a" PP.type_value a PP.type_value b in - info title full () + let message () = "" in + let data = [ + ("a" , fun () -> Format.asprintf "(%a)" PP.type_value a) ; + ("b" , fun () -> Format.asprintf "(%a)" PP.type_value b ) + ] in + error ~data title message () let different_literals name a b () = let title () = name ^ " are different" in - let full () = Format.asprintf "%a VS %a" PP.literal a PP.literal b in - info title full () + let message () = "" in + let data = [ + ("a" , fun () -> Format.asprintf "(%a)" PP.literal a) ; + ("b" , fun () -> Format.asprintf "(%a)" PP.literal b ) + ] in + error ~data title message () let different_values name a b () = let title () = name ^ " are different" in - let full () = Format.asprintf "%a VS %a" PP.value a PP.value b in - info title full () + let message () = "" in + let data = [ + ("a" , fun () -> Format.asprintf "(%a)" PP.value a) ; + ("b" , fun () -> Format.asprintf "(%a)" PP.value b ) + ] in + error ~data title message () let different_literals_because_different_types name a b () = let title () = "literals have different types: " ^ name in - let full () = Format.asprintf "%a VS %a" PP.literal a PP.literal b in - info title full () + let message () = "" in + let data = [ + ("a" , fun () -> Format.asprintf "(%a)" PP.literal a) ; + ("b" , fun () -> Format.asprintf "(%a)" PP.literal b ) + ] in + error ~data title message () let different_values_because_different_types name a b () = let title () = "values have different types: " ^ name in - let full () = Format.asprintf "%a VS %a" PP.value a PP.value b in - info title full () + let message () = "" in + let data = [ + ("a" , fun () -> Format.asprintf "(%a)" PP.value a) ; + ("b" , fun () -> Format.asprintf "(%a)" PP.value b ) + ] in + error ~data title message () let error_uncomparable_literals name a b () = let title () = name ^ " are different" in - let full () = Format.asprintf "%a VS %a" PP.literal a PP.literal b in - info title full () + let message () = "" in + let data = [ + ("a" , fun () -> Format.asprintf "(%a)" PP.literal a) ; + ("b" , fun () -> Format.asprintf "(%a)" PP.literal b ) + ] in + error ~data title message () let error_uncomparable_values name a b () = let title () = name ^ " are different" in - let full () = Format.asprintf "%a VS %a" PP.value a PP.value b in - info title full () + let message () = "" in + let data = [ + ("a" , fun () -> Format.asprintf "(%a)" PP.value a) ; + ("b" , fun () -> Format.asprintf "(%a)" PP.value b ) + ] in + error ~data title message () let different_size_values name a b () = let title () = name in - let full () = Format.asprintf "%a VS %a" PP.value a PP.value b in - error title full () + let message () = "" in + let data = [ + ("a" , fun () -> Format.asprintf "(%a)" PP.value a) ; + ("b" , fun () -> Format.asprintf "(%a)" PP.value b ) + ] in + error ~data title message () let missing_key_in_record_value k () = let title () = "missing keys in one of the records" in - let content () = Format.asprintf "%s" k in - error title content () + let message () = "" in + let data = [ + ("missing_key" , fun () -> Format.asprintf "%s" k) + ] in + error ~data title message () end module Free_variables = struct