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 |