avoid runtime warning with discriminators due to 'Code.del_eqn'
authorblanchet
Fri, 17 Jun 2016 21:25:59 +0200
changeset 63313 0c956a9a0ac0
parent 63312 d75d1e399698
child 63314 df655e33995c
avoid runtime warning with discriminators due to 'Code.del_eqn'
src/HOL/Tools/Ctr_Sugar/ctr_sugar.ML
--- a/src/HOL/Tools/Ctr_Sugar/ctr_sugar.ML	Fri Jun 17 21:00:32 2016 +0200
+++ b/src/HOL/Tools/Ctr_Sugar/ctr_sugar.ML	Fri Jun 17 21:25:59 2016 +0200
@@ -805,12 +805,13 @@
             (thm, asm_thm)
           end;
 
-        val (sel_defs, all_sel_thms, sel_thmss, disc_defs, disc_thmss, nontriv_disc_thmss,
-             discI_thms, nontriv_discI_thms, distinct_disc_thms, distinct_disc_thmsss,
-             exhaust_disc_thms, exhaust_sel_thms, all_collapse_thms, safe_collapse_thms,
-             expand_thms, split_sel_thms, split_sel_asm_thms, case_eq_if_thms, disc_eq_case_thms) =
+        val (sel_defs, all_sel_thms, sel_thmss, disc_defs, nontriv_disc_defs, disc_thmss,
+             nontriv_disc_thmss, discI_thms, nontriv_discI_thms, distinct_disc_thms,
+             distinct_disc_thmsss, exhaust_disc_thms, exhaust_sel_thms, all_collapse_thms,
+             safe_collapse_thms, expand_thms, split_sel_thms, split_sel_asm_thms, case_eq_if_thms,
+             disc_eq_case_thms) =
           if no_discs_sels then
-            ([], [], [], [], [], [], [], [], [], [], [], [], [], [], [], [], [], [], [])
+            ([], [], [], [], [], [], [], [], [], [], [], [], [], [], [], [], [], [], [], [])
           else
             let
               val udiscs = map (rapp u) discs;
@@ -870,6 +871,9 @@
               val has_alternate_disc_def =
                 exists (fn def => Thm.eq_thm_prop (def, alternate_disc_no_def)) disc_defs;
 
+              val nontriv_disc_defs = disc_defs
+                |> filter_out (member Thm.eq_thm_prop [unique_disc_no_def, alternate_disc_no_def]);
+
               val disc_defs' =
                 map2 (fn k => fn def =>
                   if Thm.eq_thm_prop (def, unique_disc_no_def) then mk_unique_disc_def ()
@@ -1044,11 +1048,11 @@
                   |> Conjunction.elim_balanced (length goals)
                 end;
             in
-              (sel_defs, all_sel_thms, sel_thmss, disc_defs, disc_thmss, nontriv_disc_thmss,
-               discI_thms, nontriv_discI_thms, distinct_disc_thms, distinct_disc_thmsss,
-               [exhaust_disc_thm], [exhaust_sel_thm], all_collapse_thms, safe_collapse_thms,
-               [expand_thm], [split_sel_thm], [split_sel_asm_thm], [case_eq_if_thm],
-               disc_eq_case_thms)
+              (sel_defs, all_sel_thms, sel_thmss, disc_defs, nontriv_disc_defs, disc_thmss,
+               nontriv_disc_thmss, discI_thms, nontriv_discI_thms, distinct_disc_thms,
+               distinct_disc_thmsss, [exhaust_disc_thm], [exhaust_sel_thm], all_collapse_thms,
+               safe_collapse_thms, [expand_thm], [split_sel_thm], [split_sel_asm_thm],
+               [case_eq_if_thm], disc_eq_case_thms)
             end;
 
         val case_distrib_thm =
@@ -1118,7 +1122,7 @@
           |> Local_Theory.declaration {syntax = false, pervasive = true}
             (fn phi => Case_Translation.register
                (Morphism.term phi casex) (map (Morphism.term phi) ctrs))
-          |> Local_Theory.background_theory (fold (fold Code.del_eqn) [disc_defs, sel_defs])
+          |> Local_Theory.background_theory (fold (fold Code.del_eqn) [nontriv_disc_defs, sel_defs])
           |> plugins code_plugin ?
             Local_Theory.declaration {syntax = false, pervasive = false}
               (fn phi => Context.mapping
@@ -1135,7 +1139,7 @@
            exhaust = exhaust_thm, nchotomy = nchotomy_thm, injects = inject_thms,
            distincts = distinct_thms, case_thms = case_thms, case_cong = case_cong_thm,
            case_cong_weak = case_cong_weak_thm, case_distribs = [case_distrib_thm],
-           split = split_thm, split_asm = split_asm_thm, disc_defs = disc_defs,
+           split = split_thm, split_asm = split_asm_thm, disc_defs = nontriv_disc_defs,
            disc_thmss = disc_thmss, discIs = discI_thms, disc_eq_cases = disc_eq_case_thms,
            sel_defs = sel_defs, sel_thmss = sel_thmss, distinct_discsss = distinct_disc_thmsss,
            exhaust_discs = exhaust_disc_thms, exhaust_sels = exhaust_sel_thms,