diff -r ffb5a181844b -r 8268b277d240 Nominal/nominal_dt_quot.ML --- a/Nominal/nominal_dt_quot.ML Tue Dec 28 00:20:50 2010 +0000 +++ b/Nominal/nominal_dt_quot.ML Tue Dec 28 19:51:25 2010 +0000 @@ -42,7 +42,8 @@ val prove_strong_exhausts: Proof.context -> thm list -> bclause list list list -> thm list -> thm list -> thm list -> thm list -> thm list -> thm list - val prove_strong_induct: Proof.context -> thm -> thm list -> bclause list list list -> thm + val prove_strong_induct: Proof.context -> thm -> thm list -> thm list -> bclause list list list -> + thm list end structure Nominal_Dt_Quot: NOMINAL_DT_QUOT = @@ -668,7 +669,7 @@ mk_full_horn (params @ [(c_name, c_ty)]) prems'' concl' end -fun prove_strong_induct lthy induct exhausts bclausesss = +fun prove_strong_induct lthy induct exhausts size_thms bclausesss = let val ((insts, [induct']), lthy') = Variable.import true [induct] lthy @@ -706,17 +707,16 @@ end) ctxt THEN_ALL_NEW asm_full_simp_tac HOL_basic_ss - val thm = Goal.prove_multi lthy'' [] prems' concls + val size_simp_tac = + simp_tac (size_simpset addsimps (@{thms comp_def snd_conv} @ size_thms)) + in + Goal.prove_multi lthy'' [] prems' concls (fn {prems, context} => - print_tac "start" - THEN Induction_Schema.induction_schema_tac context prems - THEN print_tac "after induct schema" + Induction_Schema.induction_schema_tac context prems THEN RANGE (map (pat_tac context) exhausts) 1 - THEN print_tac "after pat" - THEN Skip_Proof.cheat_tac (ProofContext.theory_of context) - ) - in - @{thm TrueI} + THEN prove_termination_ind context 1 + THEN ALLGOALS size_simp_tac) + |> ProofContext.export lthy'' lthy end