src/HOL/Codatatype/Tools/bnf_fp_sugar_tactics.ML
changeset 50399 94ad5ba23541
parent 50398 0f71da2988d2
child 50400 83b867707af2
     1.1 --- a/src/HOL/Codatatype/Tools/bnf_fp_sugar_tactics.ML	Fri Sep 14 22:23:11 2012 +0200
     1.2 +++ b/src/HOL/Codatatype/Tools/bnf_fp_sugar_tactics.ML	Fri Sep 14 22:23:11 2012 +0200
     1.3 @@ -32,14 +32,13 @@
     1.4  
     1.5  fun smash_spurious_fs lthy thm =
     1.6    let
     1.7 -    val spurious_fs =
     1.8 +    val fs =
     1.9        Term.add_vars (prop_of thm) []
    1.10        |> filter (fn (_, Type (@{type_name fun}, [_, T'])) => T' <> HOLogic.boolT | _ => false);
    1.11 -    val cxs =
    1.12 -      map (fn s as (_, T) =>
    1.13 -        (certify lthy (Var s), certify lthy (id_abs (domain_type T)))) spurious_fs;
    1.14 +    val cfs =
    1.15 +      map (fn f as (_, T) => (certify lthy (Var f), certify lthy (id_abs (domain_type T)))) fs;
    1.16    in
    1.17 -    Drule.cterm_instantiate cxs thm
    1.18 +    Drule.cterm_instantiate cfs thm
    1.19    end;
    1.20  
    1.21  val smash_spurious_fs_tac = PRIMITIVE o smash_spurious_fs;
    1.22 @@ -113,7 +112,7 @@
    1.23  val induct_prem_prem_thms_delayed =
    1.24    @{thms fsts_def[abs_def] snds_def[abs_def] sum_setl_def[abs_def] sum_setr_def[abs_def]};
    1.25  
    1.26 -(* TODO: Get rid of the "auto_tac" (or at least use a naked context) *)
    1.27 +(* TODO: Get rid of "auto_tac" (or at least use a naked context) *)
    1.28  fun mk_induct_prem_prem_endgame_tac _ 0 = atac ORELSE' rtac @{thm singletonI}
    1.29    | mk_induct_prem_prem_endgame_tac ctxt qq =
    1.30      REPEAT_DETERM_N qq o
    1.31 @@ -123,7 +122,7 @@
    1.32  
    1.33  fun mk_induct_discharge_prem_prems_tac ctxt nn ixs set_natural's pre_set_defs =
    1.34    EVERY' (maps (fn ((pp, jj), (qq, kk)) =>
    1.35 -      [select_prem_tac nn (dtac meta_spec) kk, rotate_tac ~1 (*FIXME: needed?*), etac meta_mp,
    1.36 +      [select_prem_tac nn (dtac meta_spec) kk, etac meta_mp,
    1.37         SELECT_GOAL (Local_Defs.unfold_tac ctxt pre_set_defs), (* FIXME: ### why on a line of its own? *)
    1.38         SELECT_GOAL (Local_Defs.unfold_tac ctxt (set_natural's @ induct_prem_prem_thms)),
    1.39         SELECT_GOAL (Local_Defs.unfold_tac ctxt