src/HOL/Tools/BNF/bnf_fp_def_sugar_tactics.ML
changeset 63842 f738df816abf
parent 63841 813a574da746
child 63845 61a03e429cbd
equal deleted inserted replaced
63841:813a574da746 63842:f738df816abf
     6 Tactics for datatype and codatatype sugar.
     6 Tactics for datatype and codatatype sugar.
     7 *)
     7 *)
     8 
     8 
     9 signature BNF_FP_DEF_SUGAR_TACTICS =
     9 signature BNF_FP_DEF_SUGAR_TACTICS =
    10 sig
    10 sig
       
    11   val sumprod_thms_rel: thm list
    11   val sumprod_thms_set: thm list
    12   val sumprod_thms_set: thm list
    12   val basic_sumprod_thms_set: thm list
    13   val basic_sumprod_thms_set: thm list
    13 
    14 
    14   val mk_case_transfer_tac: Proof.context -> thm -> thm list -> tactic
    15   val mk_case_transfer_tac: Proof.context -> thm -> thm list -> tactic
    15   val mk_coinduct_tac: Proof.context -> thm list -> int -> int list -> thm -> thm list ->
    16   val mk_coinduct_tac: Proof.context -> thm list -> int -> int list -> thm -> thm list ->
    29   val mk_exhaust_tac: Proof.context -> int -> thm list -> thm -> thm -> tactic
    30   val mk_exhaust_tac: Proof.context -> int -> thm list -> thm -> thm -> tactic
    30   val mk_half_distinct_tac: Proof.context -> thm -> thm -> thm list -> tactic
    31   val mk_half_distinct_tac: Proof.context -> thm -> thm -> thm list -> tactic
    31   val mk_induct_tac: Proof.context -> int -> int list -> int list list -> int list list list ->
    32   val mk_induct_tac: Proof.context -> int -> int list -> int list list -> int list list list ->
    32     thm list -> thm -> thm list -> thm list -> thm list -> thm list list -> tactic
    33     thm list -> thm -> thm list -> thm list -> thm list -> thm list list -> tactic
    33   val mk_inject_tac: Proof.context -> thm -> thm -> thm -> tactic
    34   val mk_inject_tac: Proof.context -> thm -> thm -> thm -> tactic
    34   val mk_map_tac: Proof.context -> thm list -> thm -> thm -> thm -> thm list -> tactic
    35   val mk_map_tac: Proof.context -> thm list -> thm -> thm -> thm -> thm list -> thm list -> tactic
    35   val mk_map_disc_iff_tac: Proof.context -> cterm -> thm -> thm list -> thm list -> tactic
    36   val mk_map_disc_iff_tac: Proof.context -> cterm -> thm -> thm list -> thm list -> tactic
    36   val mk_map_sel_tac: Proof.context -> cterm -> thm -> thm list -> thm list -> thm list ->
    37   val mk_map_sel_tac: Proof.context -> cterm -> thm -> thm list -> thm list -> thm list ->
    37     thm list -> tactic
    38     thm list -> tactic
    38   val mk_rec_tac: thm list -> thm list -> thm list -> thm -> thm -> thm -> thm -> Proof.context ->
    39   val mk_rec_tac: thm list -> thm list -> thm list -> thm -> thm -> thm -> thm -> Proof.context ->
    39     tactic
    40     tactic
    40   val mk_rec_transfer_tac: Proof.context -> int -> int list -> cterm list -> cterm list ->
    41   val mk_rec_transfer_tac: Proof.context -> int -> int list -> cterm list -> cterm list ->
    41     term list list list list -> thm list -> thm list -> thm list -> thm list -> tactic
    42     term list list list list -> thm list -> thm list -> thm list -> thm list -> tactic
    42   val mk_rel_tac: Proof.context -> thm list -> thm -> thm -> thm -> thm list -> tactic
    43   val mk_rel_tac: Proof.context -> thm list -> thm -> thm -> thm -> thm list -> thm list -> tactic
    43   val mk_rel_case_tac: Proof.context -> cterm -> cterm -> thm -> thm list -> thm list -> thm list ->
    44   val mk_rel_case_tac: Proof.context -> cterm -> cterm -> thm -> thm list -> thm list -> thm list ->
    44     thm list -> thm list -> tactic
    45     thm list -> thm list -> tactic
    45   val mk_rel_coinduct0_tac: Proof.context -> thm -> cterm list -> thm list -> thm list ->
    46   val mk_rel_coinduct0_tac: Proof.context -> thm -> cterm list -> thm list -> thm list ->
    46     thm list list -> thm list list -> thm list list -> thm list -> thm list -> thm list ->
    47     thm list list -> thm list list -> thm list list -> thm list -> thm list -> thm list ->
    47     thm list -> thm list -> thm list -> tactic
    48     thm list -> thm list -> thm list -> tactic
   387   HEADGOAL (rtac ctxt dtor_coinduct' THEN'
   388   HEADGOAL (rtac ctxt dtor_coinduct' THEN'
   388     EVERY' (@{map 10} (mk_coinduct_discharge_prem_tac ctxt rel_eqs' nn)
   389     EVERY' (@{map 10} (mk_coinduct_discharge_prem_tac ctxt rel_eqs' nn)
   389       (1 upto nn) ns pre_rel_defs fp_abs_inverses abs_inverses dtor_ctors exhausts ctr_defss discsss
   390       (1 upto nn) ns pre_rel_defs fp_abs_inverses abs_inverses dtor_ctors exhausts ctr_defss discsss
   390       selsss));
   391       selsss));
   391 
   392 
   392 fun mk_map_tac ctxt abs_inverses pre_map_def dtor_ctor fp_map' ctr_defs' =
   393 fun mk_map_tac ctxt abs_inverses pre_map_def dtor_ctor fp_map' live_nesting_map_ident0s ctr_defs' =
   393   TRYALL Goal.conjunction_tac THEN
   394   TRYALL Goal.conjunction_tac THEN
   394   unfold_thms_tac ctxt (pre_map_def :: dtor_ctor :: fp_map' :: abs_inverses @ ctr_defs' @ o_apply ::
   395   unfold_thms_tac ctxt (pre_map_def :: dtor_ctor :: fp_map' :: abs_inverses @
   395     sumprod_thms_map) THEN
   396     live_nesting_map_ident0s @
       
   397     ctr_defs' @ sumprod_thms_map @ @{thms o_def[abs_def] id_def}) THEN
   396   ALLGOALS (rtac ctxt refl);
   398   ALLGOALS (rtac ctxt refl);
   397 
   399 
   398 fun mk_map_disc_iff_tac ctxt ct exhaust discs maps =
   400 fun mk_map_disc_iff_tac ctxt ct exhaust discs maps =
   399   TRYALL Goal.conjunction_tac THEN
   401   TRYALL Goal.conjunction_tac THEN
   400   ALLGOALS (rtac ctxt (infer_instantiate' ctxt [SOME ct] exhaust) THEN_ALL_NEW
   402   ALLGOALS (rtac ctxt (infer_instantiate' ctxt [SOME ct] exhaust) THEN_ALL_NEW
   412     @{thms not_True_eq_False not_False_eq_True}) THEN
   414     @{thms not_True_eq_False not_False_eq_True}) THEN
   413   TRYALL (etac ctxt FalseE ORELSE' etac ctxt @{thm TrueE}) THEN
   415   TRYALL (etac ctxt FalseE ORELSE' etac ctxt @{thm TrueE}) THEN
   414   unfold_thms_tac ctxt (@{thm id_apply} :: maps @ sels @ map_id0s) THEN
   416   unfold_thms_tac ctxt (@{thm id_apply} :: maps @ sels @ map_id0s) THEN
   415   ALLGOALS (rtac ctxt refl);
   417   ALLGOALS (rtac ctxt refl);
   416 
   418 
   417 fun mk_rel_tac ctxt abs_inverses pre_rel_def dtor_ctor fp_rel ctr_defs' =
   419 fun mk_rel_tac ctxt abs_inverses pre_rel_def dtor_ctor fp_rel live_nesting_rel_eqs ctr_defs' =
   418   TRYALL Goal.conjunction_tac THEN
   420   TRYALL Goal.conjunction_tac THEN
   419   unfold_thms_tac ctxt (pre_rel_def :: dtor_ctor :: fp_rel :: abs_inverses @ ctr_defs' @ o_apply ::
   421   unfold_thms_tac ctxt (pre_rel_def :: dtor_ctor :: fp_rel :: abs_inverses @ live_nesting_rel_eqs @
   420     sumprod_thms_rel @ @{thms vimage2p_def sum.inject sum.distinct(1)[THEN eq_False[THEN iffD2]]
   422     ctr_defs' @ sumprod_thms_rel @ @{thms vimage2p_def o_apply sum.inject
   421       not_False_eq_True}) THEN
   423       sum.distinct(1)[THEN eq_False[THEN iffD2]] not_False_eq_True}) THEN
   422   ALLGOALS (resolve_tac ctxt [TrueI, refl]);
   424   ALLGOALS (resolve_tac ctxt [TrueI, refl]);
   423 
   425 
   424 fun mk_rel_case_tac ctxt ct1 ct2 exhaust injects rel_injects distincts rel_distincts rel_eqs =
   426 fun mk_rel_case_tac ctxt ct1 ct2 exhaust injects rel_injects distincts rel_distincts rel_eqs =
   425   HEADGOAL (rtac ctxt (infer_instantiate' ctxt [SOME ct1] exhaust) THEN_ALL_NEW
   427   HEADGOAL (rtac ctxt (infer_instantiate' ctxt [SOME ct1] exhaust) THEN_ALL_NEW
   426     rtac ctxt (infer_instantiate' ctxt [SOME ct2] exhaust) THEN_ALL_NEW
   428     rtac ctxt (infer_instantiate' ctxt [SOME ct2] exhaust) THEN_ALL_NEW