author | paulson |
Wed, 13 Jan 1999 11:57:09 +0100 | |
changeset 6112 | 5e4871c5136b |
parent 6071 | 1b2392ac5752 |
child 6153 | bff90585cce5 |
permissions | -rw-r--r-- |
1461 | 1 |
(* Title: ZF/ex/Primrec |
515 | 2 |
ID: $Id$ |
1461 | 3 |
Author: Lawrence C Paulson, Cambridge University Computer Laboratory |
515 | 4 |
Copyright 1994 University of Cambridge |
5 |
||
6 |
Primitive Recursive Functions |
|
7 |
||
8 |
Proof adopted from |
|
9 |
Nora Szasz, |
|
10 |
A Machine Checked Proof that Ackermann's Function is not Primitive Recursive, |
|
11 |
In: Huet & Plotkin, eds., Logical Environments (CUP, 1993), 317-338. |
|
12 |
||
13 |
See also E. Mendelson, Introduction to Mathematical Logic. |
|
14 |
(Van Nostrand, 1964), page 250, exercise 11. |
|
15 |
*) |
|
16 |
||
17 |
(*** Inductive definition of the PR functions ***) |
|
18 |
||
6044
e0f9d930e956
Needs separate theory Primrec_defs due to new inductive defs package
paulson
parents:
5268
diff
changeset
|
19 |
(* c: prim_rec ==> c: list(nat) -> nat *) |
e0f9d930e956
Needs separate theory Primrec_defs due to new inductive defs package
paulson
parents:
5268
diff
changeset
|
20 |
val prim_rec_into_fun = prim_rec.dom_subset RS subsetD; |
515 | 21 |
|
6044
e0f9d930e956
Needs separate theory Primrec_defs due to new inductive defs package
paulson
parents:
5268
diff
changeset
|
22 |
simpset_ref() := simpset() setSolver (type_auto_tac ([prim_rec_into_fun] @ |
e0f9d930e956
Needs separate theory Primrec_defs due to new inductive defs package
paulson
parents:
5268
diff
changeset
|
23 |
pr_typechecks @ prim_rec.intrs)); |
515 | 24 |
|
6071 | 25 |
Goal "i:nat ==> ACK(i): prim_rec"; |
6070 | 26 |
by (induct_tac "i" 1); |
2469 | 27 |
by (ALLGOALS Asm_simp_tac); |
6044
e0f9d930e956
Needs separate theory Primrec_defs due to new inductive defs package
paulson
parents:
5268
diff
changeset
|
28 |
qed "ACK_in_prim_rec"; |
515 | 29 |
|
30 |
val ack_typechecks = |
|
6044
e0f9d930e956
Needs separate theory Primrec_defs due to new inductive defs package
paulson
parents:
5268
diff
changeset
|
31 |
[ACK_in_prim_rec, prim_rec_into_fun RS apply_type, |
515 | 32 |
add_type, list_add_type, nat_into_Ord] @ |
6044
e0f9d930e956
Needs separate theory Primrec_defs due to new inductive defs package
paulson
parents:
5268
diff
changeset
|
33 |
nat_typechecks @ list.intrs @ prim_rec.intrs; |
515 | 34 |
|
6071 | 35 |
simpset_ref() := simpset() setSolver (type_auto_tac ack_typechecks); |
515 | 36 |
|
5137 | 37 |
Goal "[| i:nat; j:nat |] ==> ack(i,j): nat"; |
6071 | 38 |
by Auto_tac; |
760 | 39 |
qed "ack_type"; |
6071 | 40 |
Addsimps [ack_type]; |
515 | 41 |
|
42 |
(** Ackermann's function cases **) |
|
43 |
||
44 |
(*PROPERTY A 1*) |
|
6071 | 45 |
Goal "j:nat ==> ack(0,j) = succ(j)"; |
4091 | 46 |
by (asm_simp_tac (simpset() addsimps [SC]) 1); |
782
200a16083201
added bind_thm for theorems defined by "standard ..."
clasohm
parents:
760
diff
changeset
|
47 |
qed "ack_0"; |
515 | 48 |
|
49 |
(*PROPERTY A 2*) |
|
6071 | 50 |
Goal "ack(succ(i), 0) = ack(i,1)"; |
4091 | 51 |
by (asm_simp_tac (simpset() addsimps [CONST,PREC_0]) 1); |
782
200a16083201
added bind_thm for theorems defined by "standard ..."
clasohm
parents:
760
diff
changeset
|
52 |
qed "ack_succ_0"; |
515 | 53 |
|
54 |
(*PROPERTY A 3*) |
|
6071 | 55 |
Goal "[| i:nat; j:nat |] \ |
56 |
\ ==> ack(succ(i), succ(j)) = ack(i, ack(succ(i), j))"; |
|
4091 | 57 |
by (asm_simp_tac (simpset() addsimps [CONST,PREC_succ,COMP_1,PROJ_0]) 1); |
782
200a16083201
added bind_thm for theorems defined by "standard ..."
clasohm
parents:
760
diff
changeset
|
58 |
qed "ack_succ_succ"; |
515 | 59 |
|
2469 | 60 |
Addsimps [ack_0, ack_succ_0, ack_succ_succ, ack_type, nat_into_Ord]; |
6071 | 61 |
Delsimps [ACK_0, ACK_succ]; |
62 |
||
515 | 63 |
|
64 |
(*PROPERTY A 4*) |
|
5137 | 65 |
Goal "i:nat ==> ALL j:nat. j < ack(i,j)"; |
6070 | 66 |
by (induct_tac "i" 1); |
2469 | 67 |
by (Asm_simp_tac 1); |
515 | 68 |
by (rtac ballI 1); |
6070 | 69 |
by (induct_tac "j" 1); |
6071 | 70 |
by (etac (succ_leI RS lt_trans1) 2); |
71 |
by (rtac (nat_0I RS nat_0_le RS lt_trans) 1); |
|
72 |
by Auto_tac; |
|
6112 | 73 |
qed_spec_mp "lt_ack2"; |
515 | 74 |
|
75 |
(*PROPERTY A 5-, the single-step lemma*) |
|
5137 | 76 |
Goal "[| i:nat; j:nat |] ==> ack(i,j) < ack(i, succ(j))"; |
6070 | 77 |
by (induct_tac "i" 1); |
4091 | 78 |
by (ALLGOALS (asm_simp_tac (simpset() addsimps [lt_ack2]))); |
782
200a16083201
added bind_thm for theorems defined by "standard ..."
clasohm
parents:
760
diff
changeset
|
79 |
qed "ack_lt_ack_succ2"; |
515 | 80 |
|
81 |
(*PROPERTY A 5, monotonicity for < *) |
|
5137 | 82 |
Goal "[| j<k; i:nat; k:nat |] ==> ack(i,j) < ack(i,k)"; |
515 | 83 |
by (forward_tac [lt_nat_in_nat] 1 THEN assume_tac 1); |
84 |
by (etac succ_lt_induct 1); |
|
85 |
by (assume_tac 1); |
|
86 |
by (rtac lt_trans 2); |
|
87 |
by (REPEAT (ares_tac ([ack_lt_ack_succ2, ack_type] @ pr_typechecks) 1)); |
|
760 | 88 |
qed "ack_lt_mono2"; |
515 | 89 |
|
90 |
(*PROPERTY A 5', monotonicity for le *) |
|
5147
825877190618
More tidying and removal of "\!\!... from Goal commands
paulson
parents:
5137
diff
changeset
|
91 |
Goal "[| j le k; i: nat; k:nat |] ==> ack(i,j) le ack(i,k)"; |
3840 | 92 |
by (res_inst_tac [("f", "%j. ack(i,j)")] Ord_lt_mono_imp_le_mono 1); |
515 | 93 |
by (REPEAT (ares_tac [ack_lt_mono2, ack_type RS nat_into_Ord] 1)); |
782
200a16083201
added bind_thm for theorems defined by "standard ..."
clasohm
parents:
760
diff
changeset
|
94 |
qed "ack_le_mono2"; |
515 | 95 |
|
96 |
(*PROPERTY A 6*) |
|
5147
825877190618
More tidying and removal of "\!\!... from Goal commands
paulson
parents:
5137
diff
changeset
|
97 |
Goal "[| i:nat; j:nat |] ==> ack(i, succ(j)) le ack(succ(i), j)"; |
6070 | 98 |
by (induct_tac "j" 1); |
2469 | 99 |
by (ALLGOALS Asm_simp_tac); |
515 | 100 |
by (rtac ack_le_mono2 1); |
101 |
by (rtac (lt_ack2 RS succ_leI RS le_trans) 1); |
|
102 |
by (REPEAT (ares_tac (ack_typechecks) 1)); |
|
760 | 103 |
qed "ack2_le_ack1"; |
515 | 104 |
|
105 |
(*PROPERTY A 7-, the single-step lemma*) |
|
5137 | 106 |
Goal "[| i:nat; j:nat |] ==> ack(i,j) < ack(succ(i),j)"; |
515 | 107 |
by (rtac (ack_lt_mono2 RS lt_trans2) 1); |
108 |
by (rtac ack2_le_ack1 4); |
|
109 |
by (REPEAT (ares_tac ([nat_le_refl, ack_type] @ pr_typechecks) 1)); |
|
760 | 110 |
qed "ack_lt_ack_succ1"; |
515 | 111 |
|
112 |
(*PROPERTY A 7, monotonicity for < *) |
|
5137 | 113 |
Goal "[| i<j; j:nat; k:nat |] ==> ack(i,k) < ack(j,k)"; |
515 | 114 |
by (forward_tac [lt_nat_in_nat] 1 THEN assume_tac 1); |
115 |
by (etac succ_lt_induct 1); |
|
116 |
by (assume_tac 1); |
|
117 |
by (rtac lt_trans 2); |
|
118 |
by (REPEAT (ares_tac ([ack_lt_ack_succ1, ack_type] @ pr_typechecks) 1)); |
|
760 | 119 |
qed "ack_lt_mono1"; |
515 | 120 |
|
121 |
(*PROPERTY A 7', monotonicity for le *) |
|
5147
825877190618
More tidying and removal of "\!\!... from Goal commands
paulson
parents:
5137
diff
changeset
|
122 |
Goal "[| i le j; j:nat; k:nat |] ==> ack(i,k) le ack(j,k)"; |
3840 | 123 |
by (res_inst_tac [("f", "%j. ack(j,k)")] Ord_lt_mono_imp_le_mono 1); |
515 | 124 |
by (REPEAT (ares_tac [ack_lt_mono1, ack_type RS nat_into_Ord] 1)); |
760 | 125 |
qed "ack_le_mono1"; |
515 | 126 |
|
127 |
(*PROPERTY A 8*) |
|
5137 | 128 |
Goal "j:nat ==> ack(1,j) = succ(succ(j))"; |
6070 | 129 |
by (induct_tac "j" 1); |
2469 | 130 |
by (ALLGOALS Asm_simp_tac); |
760 | 131 |
qed "ack_1"; |
515 | 132 |
|
133 |
(*PROPERTY A 9*) |
|
5137 | 134 |
Goal "j:nat ==> ack(succ(1),j) = succ(succ(succ(j#+j)))"; |
6070 | 135 |
by (induct_tac "j" 1); |
4091 | 136 |
by (ALLGOALS (asm_simp_tac (simpset() addsimps [ack_1, add_succ_right]))); |
782
200a16083201
added bind_thm for theorems defined by "standard ..."
clasohm
parents:
760
diff
changeset
|
137 |
qed "ack_2"; |
515 | 138 |
|
139 |
(*PROPERTY A 10*) |
|
5147
825877190618
More tidying and removal of "\!\!... from Goal commands
paulson
parents:
5137
diff
changeset
|
140 |
Goal "[| i1:nat; i2:nat; j:nat |] ==> \ |
515 | 141 |
\ ack(i1, ack(i2,j)) < ack(succ(succ(i1#+i2)), j)"; |
142 |
by (rtac (ack2_le_ack1 RSN (2,lt_trans2)) 1); |
|
2469 | 143 |
by (Asm_simp_tac 1); |
515 | 144 |
by (rtac (add_le_self RS ack_le_mono1 RS lt_trans1) 1); |
145 |
by (rtac (add_le_self2 RS ack_lt_mono1 RS ack_lt_mono2) 5); |
|
6071 | 146 |
by Auto_tac; |
760 | 147 |
qed "ack_nest_bound"; |
515 | 148 |
|
149 |
(*PROPERTY A 11*) |
|
5147
825877190618
More tidying and removal of "\!\!... from Goal commands
paulson
parents:
5137
diff
changeset
|
150 |
Goal "[| i1:nat; i2:nat; j:nat |] ==> \ |
515 | 151 |
\ ack(i1,j) #+ ack(i2,j) < ack(succ(succ(succ(succ(i1#+i2)))), j)"; |
152 |
by (res_inst_tac [("j", "ack(succ(1), ack(i1 #+ i2, j))")] lt_trans 1); |
|
4091 | 153 |
by (asm_simp_tac (simpset() addsimps [ack_2]) 1); |
515 | 154 |
by (rtac (ack_nest_bound RS lt_trans2) 2); |
2469 | 155 |
by (Asm_simp_tac 5); |
515 | 156 |
by (rtac (add_le_mono RS leI RS leI) 1); |
157 |
by (REPEAT (ares_tac ([add_le_self, add_le_self2, ack_le_mono1] @ |
|
158 |
ack_typechecks) 1)); |
|
760 | 159 |
qed "ack_add_bound"; |
515 | 160 |
|
161 |
(*PROPERTY A 12. Article uses existential quantifier but the ALF proof |
|
162 |
used k#+4. Quantified version must be nested EX k'. ALL i,j... *) |
|
5147
825877190618
More tidying and removal of "\!\!... from Goal commands
paulson
parents:
5137
diff
changeset
|
163 |
Goal "[| i < ack(k,j); j:nat; k:nat |] ==> \ |
515 | 164 |
\ i#+j < ack(succ(succ(succ(succ(k)))), j)"; |
165 |
by (res_inst_tac [("j", "ack(k,j) #+ ack(0,j)")] lt_trans 1); |
|
166 |
by (rtac (ack_add_bound RS lt_trans2) 2); |
|
4091 | 167 |
by (asm_simp_tac (simpset() addsimps [add_0_right]) 5); |
515 | 168 |
by (REPEAT (ares_tac ([add_lt_mono, lt_ack2] @ ack_typechecks) 1)); |
782
200a16083201
added bind_thm for theorems defined by "standard ..."
clasohm
parents:
760
diff
changeset
|
169 |
qed "ack_add_bound2"; |
515 | 170 |
|
171 |
(*** MAIN RESULT ***) |
|
172 |
||
2469 | 173 |
Addsimps [list_add_type, nat_into_Ord]; |
515 | 174 |
|
6065 | 175 |
Goalw [SC_def] "l: list(nat) ==> SC ` l < ack(1, list_add(l))"; |
176 |
by (exhaust_tac "l" 1); |
|
4091 | 177 |
by (asm_simp_tac (simpset() addsimps [succ_iff]) 1); |
178 |
by (asm_simp_tac (simpset() addsimps [ack_1, add_le_self]) 1); |
|
782
200a16083201
added bind_thm for theorems defined by "standard ..."
clasohm
parents:
760
diff
changeset
|
179 |
qed "SC_case"; |
515 | 180 |
|
181 |
(*PROPERTY A 4'? Extra lemma needed for CONST case, constant functions*) |
|
5137 | 182 |
Goal "[| i:nat; j:nat |] ==> i < ack(i,j)"; |
6070 | 183 |
by (induct_tac "i" 1); |
4091 | 184 |
by (asm_simp_tac (simpset() addsimps [nat_0_le]) 1); |
515 | 185 |
by (etac ([succ_leI, ack_lt_ack_succ1] MRS lt_trans1) 1); |
6071 | 186 |
by Auto_tac; |
760 | 187 |
qed "lt_ack1"; |
515 | 188 |
|
5068 | 189 |
Goalw [CONST_def] |
5147
825877190618
More tidying and removal of "\!\!... from Goal commands
paulson
parents:
5137
diff
changeset
|
190 |
"[| l: list(nat); k: nat |] ==> CONST(k) ` l < ack(k, list_add(l))"; |
4091 | 191 |
by (asm_simp_tac (simpset() addsimps [lt_ack1]) 1); |
782
200a16083201
added bind_thm for theorems defined by "standard ..."
clasohm
parents:
760
diff
changeset
|
192 |
qed "CONST_case"; |
515 | 193 |
|
5068 | 194 |
Goalw [PROJ_def] |
5147
825877190618
More tidying and removal of "\!\!... from Goal commands
paulson
parents:
5137
diff
changeset
|
195 |
"l: list(nat) ==> ALL i:nat. PROJ(i) ` l < ack(0, list_add(l))"; |
2469 | 196 |
by (Asm_simp_tac 1); |
515 | 197 |
by (etac list.induct 1); |
4091 | 198 |
by (asm_simp_tac (simpset() addsimps [nat_0_le]) 1); |
2469 | 199 |
by (Asm_simp_tac 1); |
515 | 200 |
by (rtac ballI 1); |
201 |
by (eres_inst_tac [("n","x")] natE 1); |
|
4091 | 202 |
by (asm_simp_tac (simpset() addsimps [add_le_self]) 1); |
2469 | 203 |
by (Asm_simp_tac 1); |
515 | 204 |
by (etac (bspec RS lt_trans2) 1); |
205 |
by (rtac (add_le_self2 RS succ_leI) 2); |
|
6071 | 206 |
by Auto_tac; |
782
200a16083201
added bind_thm for theorems defined by "standard ..."
clasohm
parents:
760
diff
changeset
|
207 |
qed "PROJ_case_lemma"; |
515 | 208 |
val PROJ_case = PROJ_case_lemma RS bspec; |
209 |
||
210 |
(** COMP case **) |
|
211 |
||
6044
e0f9d930e956
Needs separate theory Primrec_defs due to new inductive defs package
paulson
parents:
5268
diff
changeset
|
212 |
Goal "fs : list({f: prim_rec . \ |
1461 | 213 |
\ EX kf:nat. ALL l:list(nat). \ |
214 |
\ f`l < ack(kf, list_add(l))}) \ |
|
215 |
\ ==> EX k:nat. ALL l: list(nat). \ |
|
515 | 216 |
\ list_add(map(%f. f ` l, fs)) < ack(k, list_add(l))"; |
217 |
by (etac list.induct 1); |
|
6071 | 218 |
by (res_inst_tac [("x","0")] bexI 1); |
219 |
by (asm_simp_tac (simpset() addsimps [lt_ack1, nat_0_le]) 1); |
|
220 |
by Auto_tac; |
|
515 | 221 |
by (rtac (ballI RS bexI) 1); |
222 |
by (rtac (add_lt_mono RS lt_trans) 1); |
|
223 |
by (REPEAT (FIRSTGOAL (etac bspec))); |
|
224 |
by (rtac ack_add_bound 5); |
|
6071 | 225 |
by Auto_tac; |
782
200a16083201
added bind_thm for theorems defined by "standard ..."
clasohm
parents:
760
diff
changeset
|
226 |
qed "COMP_map_lemma"; |
515 | 227 |
|
5068 | 228 |
Goalw [COMP_def] |
5147
825877190618
More tidying and removal of "\!\!... from Goal commands
paulson
parents:
5137
diff
changeset
|
229 |
"[| kg: nat; \ |
1461 | 230 |
\ ALL l:list(nat). g`l < ack(kg, list_add(l)); \ |
6044
e0f9d930e956
Needs separate theory Primrec_defs due to new inductive defs package
paulson
parents:
5268
diff
changeset
|
231 |
\ fs : list({f: prim_rec . \ |
1461 | 232 |
\ EX kf:nat. ALL l:list(nat). \ |
233 |
\ f`l < ack(kf, list_add(l))}) \ |
|
515 | 234 |
\ |] ==> EX k:nat. ALL l: list(nat). COMP(g,fs)`l < ack(k, list_add(l))"; |
2469 | 235 |
by (Asm_simp_tac 1); |
515 | 236 |
by (forward_tac [list_CollectD] 1); |
237 |
by (etac (COMP_map_lemma RS bexE) 1); |
|
238 |
by (rtac (ballI RS bexI) 1); |
|
239 |
by (etac (bspec RS lt_trans) 1); |
|
240 |
by (rtac lt_trans 2); |
|
241 |
by (rtac ack_nest_bound 3); |
|
242 |
by (etac (bspec RS ack_lt_mono2) 2); |
|
6071 | 243 |
by Auto_tac; |
782
200a16083201
added bind_thm for theorems defined by "standard ..."
clasohm
parents:
760
diff
changeset
|
244 |
qed "COMP_case"; |
515 | 245 |
|
246 |
(** PREC case **) |
|
247 |
||
5068 | 248 |
Goalw [PREC_def] |
5147
825877190618
More tidying and removal of "\!\!... from Goal commands
paulson
parents:
5137
diff
changeset
|
249 |
"[| ALL l:list(nat). f`l #+ list_add(l) < ack(kf, list_add(l)); \ |
1461 | 250 |
\ ALL l:list(nat). g`l #+ list_add(l) < ack(kg, list_add(l)); \ |
6044
e0f9d930e956
Needs separate theory Primrec_defs due to new inductive defs package
paulson
parents:
5268
diff
changeset
|
251 |
\ f: prim_rec; kf: nat; \ |
e0f9d930e956
Needs separate theory Primrec_defs due to new inductive defs package
paulson
parents:
5268
diff
changeset
|
252 |
\ g: prim_rec; kg: nat; \ |
1461 | 253 |
\ l: list(nat) \ |
515 | 254 |
\ |] ==> PREC(f,g)`l #+ list_add(l) < ack(succ(kf#+kg), list_add(l))"; |
6065 | 255 |
by (exhaust_tac "l" 1); |
4091 | 256 |
by (asm_simp_tac (simpset() addsimps [[nat_le_refl, lt_ack2] MRS lt_trans]) 1); |
2469 | 257 |
by (Asm_simp_tac 1); |
515 | 258 |
by (etac ssubst 1); (*get rid of the needless assumption*) |
6070 | 259 |
by (induct_tac "a" 1); |
515 | 260 |
(*base case*) |
6071 | 261 |
by (EVERY1 [Asm_simp_tac, rtac lt_trans, etac bspec, |
1461 | 262 |
assume_tac, rtac (add_le_self RS ack_lt_mono1), |
6071 | 263 |
REPEAT o ares_tac (ack_typechecks)]); |
515 | 264 |
(*ind step*) |
3328 | 265 |
by (Asm_simp_tac 1); |
515 | 266 |
by (rtac (succ_leI RS lt_trans1) 1); |
267 |
by (res_inst_tac [("j", "g ` ?ll #+ ?mm")] lt_trans1 1); |
|
268 |
by (etac bspec 2); |
|
269 |
by (rtac (nat_le_refl RS add_le_mono) 1); |
|
6071 | 270 |
(*Auto_tac is a little slow*) |
271 |
by (TRYALL (type_auto_tac ack_typechecks [])); |
|
4091 | 272 |
by (asm_simp_tac (simpset() addsimps [add_le_self2]) 1); |
515 | 273 |
(*final part of the simplification*) |
2469 | 274 |
by (Asm_simp_tac 1); |
515 | 275 |
by (rtac (add_le_self2 RS ack_le_mono1 RS lt_trans1) 1); |
276 |
by (etac ack_lt_mono2 5); |
|
6071 | 277 |
by Auto_tac; |
782
200a16083201
added bind_thm for theorems defined by "standard ..."
clasohm
parents:
760
diff
changeset
|
278 |
qed "PREC_case_lemma"; |
515 | 279 |
|
6044
e0f9d930e956
Needs separate theory Primrec_defs due to new inductive defs package
paulson
parents:
5268
diff
changeset
|
280 |
Goal "[| f: prim_rec; kf: nat; \ |
e0f9d930e956
Needs separate theory Primrec_defs due to new inductive defs package
paulson
parents:
5268
diff
changeset
|
281 |
\ g: prim_rec; kg: nat; \ |
5147
825877190618
More tidying and removal of "\!\!... from Goal commands
paulson
parents:
5137
diff
changeset
|
282 |
\ ALL l:list(nat). f`l < ack(kf, list_add(l)); \ |
825877190618
More tidying and removal of "\!\!... from Goal commands
paulson
parents:
5137
diff
changeset
|
283 |
\ ALL l:list(nat). g`l < ack(kg, list_add(l)) \ |
825877190618
More tidying and removal of "\!\!... from Goal commands
paulson
parents:
5137
diff
changeset
|
284 |
\ |] ==> EX k:nat. ALL l: list(nat). PREC(f,g)`l< ack(k, list_add(l))"; |
515 | 285 |
by (rtac (ballI RS bexI) 1); |
286 |
by (rtac ([add_le_self, PREC_case_lemma] MRS lt_trans1) 1); |
|
287 |
by (REPEAT |
|
288 |
(SOMEGOAL |
|
289 |
(FIRST' [test_assume_tac, |
|
1461 | 290 |
match_tac (ack_typechecks), |
291 |
rtac (ack_add_bound2 RS ballI) THEN' etac bspec]))); |
|
782
200a16083201
added bind_thm for theorems defined by "standard ..."
clasohm
parents:
760
diff
changeset
|
292 |
qed "PREC_case"; |
515 | 293 |
|
6044
e0f9d930e956
Needs separate theory Primrec_defs due to new inductive defs package
paulson
parents:
5268
diff
changeset
|
294 |
Goal "f:prim_rec ==> EX k:nat. ALL l:list(nat). f`l < ack(k, list_add(l))"; |
e0f9d930e956
Needs separate theory Primrec_defs due to new inductive defs package
paulson
parents:
5268
diff
changeset
|
295 |
by (etac prim_rec.induct 1); |
4152 | 296 |
by Safe_tac; |
515 | 297 |
by (DEPTH_SOLVE |
298 |
(ares_tac ([SC_case, CONST_case, PROJ_case, COMP_case, PREC_case, |
|
1461 | 299 |
bexI, ballI] @ nat_typechecks) 1)); |
6044
e0f9d930e956
Needs separate theory Primrec_defs due to new inductive defs package
paulson
parents:
5268
diff
changeset
|
300 |
qed "ack_bounds_prim_rec"; |
515 | 301 |
|
6044
e0f9d930e956
Needs separate theory Primrec_defs due to new inductive defs package
paulson
parents:
5268
diff
changeset
|
302 |
Goal "~ (lam l:list(nat). list_case(0, %x xs. ack(x,x), l)) : prim_rec"; |
515 | 303 |
by (rtac notI 1); |
6044
e0f9d930e956
Needs separate theory Primrec_defs due to new inductive defs package
paulson
parents:
5268
diff
changeset
|
304 |
by (etac (ack_bounds_prim_rec RS bexE) 1); |
515 | 305 |
by (rtac lt_irrefl 1); |
306 |
by (dres_inst_tac [("x", "[x]")] bspec 1); |
|
2469 | 307 |
by (Asm_simp_tac 1); |
6044
e0f9d930e956
Needs separate theory Primrec_defs due to new inductive defs package
paulson
parents:
5268
diff
changeset
|
308 |
by (Asm_full_simp_tac 1); |
e0f9d930e956
Needs separate theory Primrec_defs due to new inductive defs package
paulson
parents:
5268
diff
changeset
|
309 |
qed "ack_not_prim_rec"; |
515 | 310 |