more precise error message
authorblanchet
Sun, 23 Feb 2014 22:51:11 +0100
changeset 55700 cf6a029b28d8
parent 55699 1f9cc432ecd4
child 55701 38f75365fc2a
more precise error message
src/HOL/BNF_FP_Base.thy
src/HOL/Tools/BNF/bnf_fp_def_sugar.ML
--- a/src/HOL/BNF_FP_Base.thy	Sun Feb 23 22:51:11 2014 +0100
+++ b/src/HOL/BNF_FP_Base.thy	Sun Feb 23 22:51:11 2014 +0100
@@ -154,5 +154,5 @@
 ML_file "Tools/BNF/bnf_fp_n2m_tactics.ML"
 ML_file "Tools/BNF/bnf_fp_n2m.ML"
 ML_file "Tools/BNF/bnf_fp_n2m_sugar.ML"
-
+ 
 end
--- a/src/HOL/Tools/BNF/bnf_fp_def_sugar.ML	Sun Feb 23 22:51:11 2014 +0100
+++ b/src/HOL/Tools/BNF/bnf_fp_def_sugar.ML	Sun Feb 23 22:51:11 2014 +0100
@@ -273,12 +273,13 @@
     Type (_, Ts) => map (not o member (op =) (deads_of_bnf bnf)) Ts
   | _ => replicate n false);
 
-fun cannot_merge_types () = error "Mutually recursive types must have the same type parameters";
+fun cannot_merge_types fp =
+  error ("Mutually " ^ co_prefix fp ^ "recursive types must have the same type parameters");
 
-fun merge_type_arg T T' = if T = T' then T else cannot_merge_types ();
+fun merge_type_arg fp T T' = if T = T' then T else cannot_merge_types fp;
 
-fun merge_type_args (As, As') =
-  if length As = length As' then map2 merge_type_arg As As' else cannot_merge_types ();
+fun merge_type_args fp (As, As') =
+  if length As = length As' then map2 (merge_type_arg fp) As As' else cannot_merge_types fp;
 
 fun reassoc_conjs thm =
   reassoc_conjs (thm RS @{thm conj_assoc[THEN iffD1]})
@@ -970,7 +971,7 @@
 
     val Ass0 = map (map prepare_type_arg o type_args_named_constrained_of_spec) specs;
     val unsorted_Ass0 = map (map (resort_tfree HOLogic.typeS)) Ass0;
-    val unsorted_As = Library.foldr1 merge_type_args unsorted_Ass0;
+    val unsorted_As = Library.foldr1 (merge_type_args fp) unsorted_Ass0;
     val num_As = length unsorted_As;
 
     val set_boss = map (map fst o type_args_named_constrained_of_spec) specs;