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