pass auto-proved exhaustiveness properties to tactic;
authorpanny
Wed, 18 Dec 2013 14:06:34 +0100
changeset 54806 a0f024caa04c
parent 54797 be020ec8560c
child 54807 df6350c8f61a
pass auto-proved exhaustiveness properties to tactic; rightly use "%_. False" instead of undefined for unspecified conditions; get rid of ugly "if True then ... else Code.abort" in auto-generated code equations;
src/HOL/BNF/Tools/bnf_gfp_rec_sugar.ML
--- a/src/HOL/BNF/Tools/bnf_gfp_rec_sugar.ML	Wed Dec 18 11:53:40 2013 +0100
+++ b/src/HOL/BNF/Tools/bnf_gfp_rec_sugar.ML	Wed Dec 18 14:06:34 2013 +0100
@@ -765,7 +765,9 @@
     val ctr_specss = map #ctr_specs corec_specs;
     val corec_args = hd corecs
       |> fst o split_last o binder_types o fastype_of
-      |> map (Const o pair @{const_name undefined})
+      |> map (fn T => if range_type T = @{typ bool}
+          then Abs (Name.uu_, domain_type T, @{term False})
+          else Const (@{const_name undefined}, T))
       |> fold2 (fold o build_corec_arg_disc) ctr_specss disc_eqnss
       |> fold2 (fold o build_corec_args_sel lthy has_call) sel_eqnss ctr_specss;
     fun currys [] t = t
@@ -922,8 +924,8 @@
       let
         val def_thms = map (snd o snd) def_thms';
 
-        val maybe_exh_thms = if exhaustive andalso is_none maybe_tac then
-          map SOME (hd thmss'') else map (K NONE) def_thms;
+        val maybe_exh_thms = if not exhaustive then map (K NONE) def_thms else
+          map SOME (if is_none maybe_tac then hd thmss'' else exh_taut_thms);
         val thmss' = if exhaustive andalso is_none maybe_tac then tl thmss'' else thmss'';
 
         val exclss' = map (op ~~) (goal_idxss ~~ thmss');
@@ -1070,6 +1072,8 @@
                     in
                       let
                         val rhs = (if exhaustive
+                              orelse map_filter (try (fst o the)) maybe_ctr_conds_argss
+                                |> forall (equal [])
                               orelse forall is_some maybe_ctr_conds_argss
                                 andalso exists #auto_gen disc_eqns then
                             split_last (map_filter I maybe_ctr_conds_argss) ||> snd