author | wenzelm |
Wed, 02 Aug 2000 19:40:14 +0200 | |
changeset 9502 | 50ec59aff389 |
parent 8442 | 96023903c2df |
child 9747 | 043098ba5098 |
permissions | -rw-r--r-- |
5261 | 1 |
(* Title: HOL/Lambda/ListBeta.ML |
2 |
ID: $Id$ |
|
3 |
Author: Tobias Nipkow |
|
4 |
Copyright 1998 TU Muenchen |
|
5 |
*) |
|
6 |
||
7 |
Goal |
|
8 |
"v -> v' ==> !rs. v = (Var n)$$rs --> (? ss. rs => ss & v' = (Var n)$$ss)"; |
|
5326 | 9 |
by (etac beta.induct 1); |
5525 | 10 |
by (Asm_full_simp_tac 1); |
11 |
by (rtac allI 1); |
|
12 |
by (res_inst_tac [("xs","rs")] rev_exhaust 1); |
|
13 |
by (Asm_full_simp_tac 1); |
|
14 |
by (force_tac (claset() addIs [append_step1I],simpset()) 1); |
|
15 |
by (rtac allI 1); |
|
16 |
by (res_inst_tac [("xs","rs")] rev_exhaust 1); |
|
17 |
by (Asm_full_simp_tac 1); |
|
18 |
by (mk_auto_tac (claset() addIs [disjI2 RS append_step1I],simpset()) 0 3); |
|
5261 | 19 |
val lemma = result(); |
20 |
||
21 |
Goal "(Var n)$$rs -> v ==> (? ss. rs => ss & v = (Var n)$$ss)"; |
|
5318 | 22 |
by (dtac lemma 1); |
23 |
by (Blast_tac 1); |
|
5261 | 24 |
qed "head_Var_reduction"; |
25 |
||
26 |
Goal "u -> u' ==> !r rs. u = r$$rs --> \ |
|
27 |
\ ( (? r'. r -> r' & u' = r'$$rs) | \ |
|
28 |
\ (? rs'. rs => rs' & u' = r$$rs') | \ |
|
29 |
\ (? s t ts. r = Abs s & rs = t#ts & u' = s[t/0]$$ts))"; |
|
5326 | 30 |
by (etac beta.induct 1); |
5318 | 31 |
by (clarify_tac (claset() delrules [disjCI]) 1); |
8442
96023903c2df
case_tac now subsumes both boolean and datatype cases;
wenzelm
parents:
8423
diff
changeset
|
32 |
by (case_tac "r" 1); |
5318 | 33 |
by (Asm_full_simp_tac 1); |
34 |
by (asm_full_simp_tac (simpset() addsimps [App_eq_foldl_conv]) 1); |
|
35 |
by (split_asm_tac [split_if_asm] 1); |
|
36 |
by (Asm_full_simp_tac 1); |
|
37 |
by (Blast_tac 1); |
|
38 |
by (Asm_full_simp_tac 1); |
|
39 |
by (asm_full_simp_tac (simpset() addsimps [App_eq_foldl_conv]) 1); |
|
40 |
by (split_asm_tac [split_if_asm] 1); |
|
41 |
by (Asm_full_simp_tac 1); |
|
42 |
by (Asm_full_simp_tac 1); |
|
43 |
by (clarify_tac (claset() delrules [disjCI]) 1); |
|
44 |
by (dtac (App_eq_foldl_conv RS iffD1) 1); |
|
45 |
by (split_asm_tac [split_if_asm] 1); |
|
46 |
by (Asm_full_simp_tac 1); |
|
47 |
by (Blast_tac 1); |
|
48 |
by (force_tac (claset() addIs [disjI1 RS append_step1I],simpset()) 1); |
|
49 |
by (clarify_tac (claset() delrules [disjCI]) 1); |
|
50 |
by (dtac (App_eq_foldl_conv RS iffD1) 1); |
|
51 |
by (split_asm_tac [split_if_asm] 1); |
|
52 |
by (Asm_full_simp_tac 1); |
|
53 |
by (Blast_tac 1); |
|
5525 | 54 |
by (mk_auto_tac (claset() addIs [disjI2 RS append_step1I],simpset()) 0 3); |
5261 | 55 |
val lemma = result(); |
56 |
||
5455 | 57 |
val major::prems = |
58 |
Goal "[| r $$ rs -> s; !!r'. [| r -> r'; s = r' $$ rs |] ==> R; \ |
|
59 |
\ !!rs'. [| rs => rs'; s = r $$ rs' |] ==> R; \ |
|
60 |
\ !!t u us. [| r = Abs t; rs = u # us; s = t[u/0] $$ us |] ==> R |] \ |
|
61 |
\ ==> R"; |
|
62 |
by (cut_facts_tac [major RS lemma RS spec RS spec] 1); |
|
63 |
by (REPEAT_FIRST (ares_tac [refl] ORELSE' |
|
64 |
eresolve_tac (prems @ [exE, conjE, impE, disjE]))); |
|
65 |
qed "apps_betasE"; |
|
5261 | 66 |
AddSEs [apps_betasE]; |
67 |
||
68 |
Goal "r -> s ==> r$$ss -> s$$ss"; |
|
5318 | 69 |
by (res_inst_tac [("xs","ss")] rev_induct 1); |
70 |
by (Auto_tac); |
|
5261 | 71 |
qed "apps_preserves_beta"; |
72 |
Addsimps [apps_preserves_beta]; |
|
73 |
||
74 |
Goal "r ->> s ==> r$$ss ->> s$$ss"; |
|
5318 | 75 |
by (etac rtrancl_induct 1); |
76 |
by (Blast_tac 1); |
|
77 |
by (blast_tac (claset() addIs [apps_preserves_beta,rtrancl_into_rtrancl]) 1); |
|
5261 | 78 |
qed "apps_preserves_beta2"; |
79 |
Addsimps [apps_preserves_beta2]; |
|
80 |
||
81 |
Goal "!ss. rs => ss --> r$$rs -> r$$ss"; |
|
5318 | 82 |
by (res_inst_tac [("xs","rs")] rev_induct 1); |
83 |
by (Asm_full_simp_tac 1); |
|
84 |
by (Asm_full_simp_tac 1); |
|
85 |
by (Clarify_tac 1); |
|
86 |
by (res_inst_tac [("xs","ss")] rev_exhaust 1); |
|
87 |
by (Asm_full_simp_tac 1); |
|
88 |
by (Asm_full_simp_tac 1); |
|
89 |
by (dtac Snoc_step1_SnocD 1); |
|
90 |
by (Blast_tac 1); |
|
5261 | 91 |
qed_spec_mp "apps_preserves_betas"; |
92 |
Addsimps [apps_preserves_betas]; |