src/HOL/BNF/Tools/bnf_fp_rec_sugar_tactics.ML
changeset 53329 c31c0c311cf0
parent 53303 ae49b835ca01
child 53477 75a0427df7a8
equal deleted inserted replaced
53328:9228c575d67d 53329:c31c0c311cf0
    20 struct
    20 struct
    21 
    21 
    22 open BNF_Util
    22 open BNF_Util
    23 open BNF_Tactics
    23 open BNF_Tactics
    24 
    24 
    25 fun mk_primrec_tac ctxt num_extra_args map_id's map_comps fun_defs recx =
    25 fun mk_primrec_tac ctxt num_extra_args map_idents map_comps fun_defs recx =
    26   unfold_thms_tac ctxt fun_defs THEN
    26   unfold_thms_tac ctxt fun_defs THEN
    27   HEADGOAL (rtac (funpow num_extra_args (fn thm => thm RS fun_cong) recx RS trans)) THEN
    27   HEADGOAL (rtac (funpow num_extra_args (fn thm => thm RS fun_cong) recx RS trans)) THEN
    28   unfold_thms_tac ctxt (@{thms id_def split o_def fst_conv snd_conv} @ map_comps @ map_id's) THEN
    28   unfold_thms_tac ctxt (@{thms id_def split o_def fst_conv snd_conv} @ map_comps @ map_idents) THEN
    29   HEADGOAL (rtac refl);
    29   HEADGOAL (rtac refl);
    30 
    30 
    31 fun mk_primcorec_taut_tac ctxt =
    31 fun mk_primcorec_taut_tac ctxt =
    32   HEADGOAL (etac FalseE) ORELSE
    32   HEADGOAL (etac FalseE) ORELSE
    33   unfold_thms_tac ctxt @{thms de_Morgan_conj de_Morgan_disj not_not not_False_eq_True} THEN
    33   unfold_thms_tac ctxt @{thms de_Morgan_conj de_Morgan_disj not_not not_False_eq_True} THEN
    52   unfold_thms_tac ctxt defs THEN HEADGOAL (rtac thm) THEN unfold_thms_tac ctxt @{thms split};
    52   unfold_thms_tac ctxt defs THEN HEADGOAL (rtac thm) THEN unfold_thms_tac ctxt @{thms split};
    53 
    53 
    54 fun mk_primcorec_disc_tac ctxt defs disc k m exclsss =
    54 fun mk_primcorec_disc_tac ctxt defs disc k m exclsss =
    55   mk_primcorec_prelude ctxt defs disc THEN mk_primcorec_cases_tac ctxt k m exclsss;
    55   mk_primcorec_prelude ctxt defs disc THEN mk_primcorec_cases_tac ctxt k m exclsss;
    56 
    56 
    57 fun mk_primcorec_eq_tac ctxt defs sel k m exclsss maps map_id's map_comps =
    57 fun mk_primcorec_eq_tac ctxt defs sel k m exclsss maps map_idents map_comps =
    58   mk_primcorec_prelude ctxt defs (sel RS trans) THEN mk_primcorec_cases_tac ctxt k m exclsss THEN
    58   mk_primcorec_prelude ctxt defs (sel RS trans) THEN mk_primcorec_cases_tac ctxt k m exclsss THEN
    59   unfold_thms_tac ctxt (@{thms if_if_True if_if_False if_True if_False o_def split_def sum.cases} @
    59   unfold_thms_tac ctxt (@{thms if_if_True if_if_False if_True if_False o_def split_def sum.cases} @
    60     maps @ map_comps @ map_id's) THEN HEADGOAL (rtac refl);
    60     maps @ map_comps @ map_idents) THEN HEADGOAL (rtac refl);
    61 
    61 
    62 fun mk_primcorec_dtr_to_ctr_tac ctxt m collapse disc sels =
    62 fun mk_primcorec_dtr_to_ctr_tac ctxt m collapse disc sels =
    63   HEADGOAL (rtac (collapse RS sym RS trans) THEN' rtac disc THEN' REPEAT_DETERM_N m o atac) THEN
    63   HEADGOAL (rtac (collapse RS sym RS trans) THEN' rtac disc THEN' REPEAT_DETERM_N m o atac) THEN
    64   unfold_thms_tac ctxt sels THEN HEADGOAL (rtac refl);
    64   unfold_thms_tac ctxt sels THEN HEADGOAL (rtac refl);
    65 
    65