Nominal/nominal_dt_quot.ML
changeset 2630 8268b277d240
parent 2629 ffb5a181844b
child 2635 64b4cb2c2bf8
--- 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