show variants in error messages; more precise error messages (give witnesses for multiple instances)
authorChristian Sternagel
Wed, 17 Jul 2013 12:41:59 +0900
changeset 52688 1e13b2515e2b
parent 52687 72cda5eb5a39
child 52689 6419ada0664a
show variants in error messages; more precise error messages (give witnesses for multiple instances)
src/Tools/adhoc_overloading.ML
--- a/src/Tools/adhoc_overloading.ML	Wed Jul 17 12:19:14 2013 +0900
+++ b/src/Tools/adhoc_overloading.ML	Wed Jul 17 12:41:59 2013 +0900
@@ -32,10 +32,18 @@
 fun not_overloaded_error oconst =
   error ("Constant " ^ quote oconst ^ " is not declared as overloaded");
 
-fun unresolved_overloading_error ctxt (c, T) t reason =
-  error ("Unresolved overloading of " ^ quote c ^ " :: " ^
-    quote (Syntax.string_of_typ ctxt T) ^ " in " ^
-    quote (Syntax.string_of_term ctxt t) ^ " (" ^ reason ^ ")");
+fun unresolved_overloading_error ctxt (c, T) t instances =
+  let val ctxt' = Config.put show_variants true ctxt
+  in
+    cat_lines (
+      "Unresolved overloading of constant" ::
+      quote c ^ " :: " ^ quote (Syntax.string_of_typ ctxt' T) ::
+      "in term " ::
+      quote (Syntax.string_of_term ctxt' t) ::
+      (if null instances then "no instances" else "multiple instances:") ::
+    map (Syntax.string_of_term ctxt') instances)
+    |> error
+  end;
 
 (* generic data *)
 
@@ -143,7 +151,7 @@
 
 fun insert_variants_same ctxt t (Const (c, T)) =
       (case get_instances ctxt (c, T) of
-        [] => unresolved_overloading_error ctxt (c, T) t "no instances"
+        [] => unresolved_overloading_error ctxt (c, T) t []
       | [variant] => variant
       | _ => raise Same.SAME)
   | insert_variants_same _ _ _ = raise Same.SAME;
@@ -176,7 +184,7 @@
     fun check_unresolved t =
       (case filter (is_overloaded ctxt o fst) (Term.add_consts t []) of
         [] => ()
-      | ((c, T) :: _) => unresolved_overloading_error ctxt (c, T) t "multiple instances");
+      | ((c, T) :: _) => unresolved_overloading_error ctxt (c, T) t (get_instances ctxt (c, T)));
     val _ = map check_unresolved ts;
   in NONE end;