src/HOL/Codatatype/Tools/bnf_fp_sugar_tactics.ML
author blanchet
Tue, 04 Sep 2012 15:51:32 +0200
changeset 50140 5fc5211cf104
parent 50138 263b0e330d8b
child 50141 1bbd7a37fc29
permissions -rw-r--r--
implemented "mk_exhaust_tac"
     1 (*  Title:      HOL/Codatatype/Tools/bnf_fp_sugar_tactics.ML
     2     Author:     Jasmin Blanchette, TU Muenchen
     3     Copyright   2012
     4 
     5 Tactics for the LFP/GFP sugar.
     6 *)
     7 
     8 signature BNF_FP_SUGAR_TACTICS =
     9 sig
    10   val mk_exhaust_tac: Proof.context -> int -> int list -> thm list -> thm -> thm -> tactic
    11   val mk_fld_iff_unf_tac: Proof.context -> ctyp option list -> cterm -> cterm -> thm -> thm
    12     -> tactic
    13 end;
    14 
    15 structure BNF_FP_Sugar_Tactics : BNF_FP_SUGAR_TACTICS =
    16 struct
    17 
    18 open BNF_Tactics
    19 open BNF_Util
    20 
    21 fun mk_exhaust_tac ctxt n ms ctr_defs fld_iff_unf sumEN' =
    22   Local_Defs.unfold_tac ctxt (fld_iff_unf :: ctr_defs) THEN
    23   rtac sumEN' 1 THEN
    24   Local_Defs.unfold_tac ctxt @{thms all_prod_eq} THEN
    25   EVERY' (map2 (fn k => fn m =>
    26      select_prem_tac n (REPEAT_DETERM_N m o dtac @{thm meta_spec} THEN' etac @{thm meta_mp}) k THEN'
    27      atac) (1 upto n) ms) 1;
    28 
    29 fun mk_fld_iff_unf_tac ctxt cTs cfld cunf fld_unf unf_fld =
    30   (rtac iffI THEN'
    31    EVERY' (map3 (fn cTs => fn cx => fn th =>
    32      dtac (Drule.instantiate' cTs [NONE, NONE, SOME cx] arg_cong) THEN'
    33      SELECT_GOAL (Local_Defs.unfold_tac ctxt [th]) THEN'
    34      atac) [rev cTs, cTs] [cunf, cfld] [unf_fld, fld_unf])) 1;
    35 
    36 end;