more primcorec messages
authorblanchet
Thu, 05 Mar 2015 11:57:34 +0100
changeset 59602 2a6226d89fa3
parent 59601 25ae098d8de2
child 59603 427511b3d575
more primcorec messages
src/HOL/Tools/BNF/bnf_gfp_rec_sugar.ML
--- a/src/HOL/Tools/BNF/bnf_gfp_rec_sugar.ML	Thu Mar 05 11:57:34 2015 +0100
+++ b/src/HOL/Tools/BNF/bnf_gfp_rec_sugar.ML	Thu Mar 05 11:57:34 2015 +0100
@@ -578,6 +578,8 @@
    eqn_pos: int,
    user_eqn: term};
 
+fun ctr_sel_of ({ctr, sel, ...} : coeqn_data_sel) = (ctr, sel);
+
 datatype coeqn_data =
   Disc of coeqn_data_disc |
   Sel of coeqn_data_sel;
@@ -1055,12 +1057,12 @@
       |> map (sort (op < o apply2 #ctr_no |> make_ord) o flat o snd);
 
     val _ = disc_eqnss' |> map (fn x =>
-      let val d = duplicates (op = o apply2 #ctr_no) x in
-        null d orelse
+      let val dups = duplicates (op = o apply2 #ctr_no) x in
+        null dups orelse
         error_at lthy
-          (maps (fn t => filter (curry (op =) (#ctr_no t) o #ctr_no) x) d
+          (maps (fn t => filter (curry (op =) (#ctr_no t) o #ctr_no) x) dups
            |> map (fn {ctr_rhs_opt = SOME t, ...} => t | {user_eqn, ...} => user_eqn))
-          "Overspecified constructor cases"
+          "Overspecified discriminator case(s)"
       end);
 
     val sel_eqnss = map_filter (try (fn Sel x => x)) eqns_data
@@ -1068,6 +1070,15 @@
       |> fst o finds (fn (x, ({fun_name, ...} :: _)) => x = fun_name) fun_names
       |> map (flat o snd);
 
+    val _ = sel_eqnss |> map (fn x =>
+      let val dups = duplicates (op = o apply2 ctr_sel_of) x in
+        null dups orelse
+        error_at lthy
+          (maps (fn t => filter (curry (op =) (ctr_sel_of t) o ctr_sel_of) x) dups
+           |> map (fn {ctr_rhs_opt = SOME t, ...} => t | {user_eqn, ...} => user_eqn))
+          "Overspecified selector case(s)"
+      end);
+
     val arg_Tss = map (binder_types o snd o fst) fixes;
     val disc_eqnss = @{map 6} mk_actual_disc_eqns bs arg_Tss exhaustives corec_specs sel_eqnss
       disc_eqnss';