author | paulson |
Wed, 09 Apr 1997 12:32:04 +0200 | |
changeset 2922 | 580647a879cf |
parent 2891 | d8f254ad1ab9 |
child 2931 | 8658bf6c1a5b |
permissions | -rw-r--r-- |
1269 | 1 |
(* Title: HOL/Lambda/Eta.ML |
2 |
ID: $Id$ |
|
3 |
Author: Tobias Nipkow |
|
4 |
Copyright 1995 TU Muenchen |
|
5 |
||
6 |
Eta reduction, |
|
1302 | 7 |
confluence of eta, |
1269 | 8 |
commutation of beta/eta, |
9 |
confluence of beta+eta |
|
10 |
*) |
|
11 |
||
12 |
open Eta; |
|
13 |
||
1302 | 14 |
Addsimps eta.intrs; |
1269 | 15 |
|
2159
e650a3f6f600
Used nat_trans_tac. New Eta. various smaller changes.
nipkow
parents:
2116
diff
changeset
|
16 |
val eta_cases = map (eta.mk_cases dB.simps) |
e650a3f6f600
Used nat_trans_tac. New Eta. various smaller changes.
nipkow
parents:
2116
diff
changeset
|
17 |
["Abs s -e> z","s @ t -e> u","Var i -e> t"]; |
1269 | 18 |
|
2159
e650a3f6f600
Used nat_trans_tac. New Eta. various smaller changes.
nipkow
parents:
2116
diff
changeset
|
19 |
val beta_cases = map (beta.mk_cases dB.simps) |
1269 | 20 |
["s @ t -> u","Var i -> t"]; |
21 |
||
1974
b50f96543dec
Removed refs to clasets like rel_cs etc. Used implicit claset.
nipkow
parents:
1910
diff
changeset
|
22 |
AddIs eta.intrs; |
b50f96543dec
Removed refs to clasets like rel_cs etc. Used implicit claset.
nipkow
parents:
1910
diff
changeset
|
23 |
AddSEs (beta_cases@eta_cases); |
1269 | 24 |
|
2159
e650a3f6f600
Used nat_trans_tac. New Eta. various smaller changes.
nipkow
parents:
2116
diff
changeset
|
25 |
section "eta, subst and free"; |
e650a3f6f600
Used nat_trans_tac. New Eta. various smaller changes.
nipkow
parents:
2116
diff
changeset
|
26 |
|
e650a3f6f600
Used nat_trans_tac. New Eta. various smaller changes.
nipkow
parents:
2116
diff
changeset
|
27 |
goal Eta.thy "!i t u. ~free s i --> s[t/i] = s[u/i]"; |
e650a3f6f600
Used nat_trans_tac. New Eta. various smaller changes.
nipkow
parents:
2116
diff
changeset
|
28 |
by (dB.induct_tac "s" 1); |
e650a3f6f600
Used nat_trans_tac. New Eta. various smaller changes.
nipkow
parents:
2116
diff
changeset
|
29 |
by (ALLGOALS(simp_tac (addsplit (!simpset)))); |
2891 | 30 |
by (Blast_tac 1); |
31 |
by (Blast_tac 1); |
|
2159
e650a3f6f600
Used nat_trans_tac. New Eta. various smaller changes.
nipkow
parents:
2116
diff
changeset
|
32 |
qed_spec_mp "subst_not_free"; |
e650a3f6f600
Used nat_trans_tac. New Eta. various smaller changes.
nipkow
parents:
2116
diff
changeset
|
33 |
Addsimps [subst_not_free RS eqTrueI]; |
1269 | 34 |
|
35 |
goal Eta.thy "!i k. free (lift t k) i = \ |
|
36 |
\ (i < k & free t i | k < i & free t (pred i))"; |
|
2159
e650a3f6f600
Used nat_trans_tac. New Eta. various smaller changes.
nipkow
parents:
2116
diff
changeset
|
37 |
by (dB.induct_tac "t" 1); |
2031 | 38 |
by (ALLGOALS(asm_full_simp_tac (addsplit (!simpset) addcongs [conj_cong]))); |
2891 | 39 |
by (Blast_tac 2); |
2116
73bbf2cc7651
Used trans_tac (see Provers/nat_transitive.ML) to automate arithmetic.
nipkow
parents:
2083
diff
changeset
|
40 |
by(simp_tac (!simpset addsimps [pred_def] |
73bbf2cc7651
Used trans_tac (see Provers/nat_transitive.ML) to automate arithmetic.
nipkow
parents:
2083
diff
changeset
|
41 |
setloop (split_tac [expand_nat_case])) 1); |
73bbf2cc7651
Used trans_tac (see Provers/nat_transitive.ML) to automate arithmetic.
nipkow
parents:
2083
diff
changeset
|
42 |
by (safe_tac HOL_cs); |
73bbf2cc7651
Used trans_tac (see Provers/nat_transitive.ML) to automate arithmetic.
nipkow
parents:
2083
diff
changeset
|
43 |
by (ALLGOALS trans_tac); |
1269 | 44 |
qed "free_lift"; |
45 |
Addsimps [free_lift]; |
|
46 |
||
47 |
goal Eta.thy "!i k t. free (s[t/k]) i = \ |
|
48 |
\ (free s k & free t i | free s (if i<k then i else Suc i))"; |
|
2159
e650a3f6f600
Used nat_trans_tac. New Eta. various smaller changes.
nipkow
parents:
2116
diff
changeset
|
49 |
by (dB.induct_tac "s" 1); |
2116
73bbf2cc7651
Used trans_tac (see Provers/nat_transitive.ML) to automate arithmetic.
nipkow
parents:
2083
diff
changeset
|
50 |
by (Asm_simp_tac 2); |
2891 | 51 |
by (Blast_tac 2); |
2116
73bbf2cc7651
Used trans_tac (see Provers/nat_transitive.ML) to automate arithmetic.
nipkow
parents:
2083
diff
changeset
|
52 |
by (asm_full_simp_tac (addsplit (!simpset)) 2); |
73bbf2cc7651
Used trans_tac (see Provers/nat_transitive.ML) to automate arithmetic.
nipkow
parents:
2083
diff
changeset
|
53 |
by(simp_tac (!simpset addsimps [pred_def,subst_Var] |
73bbf2cc7651
Used trans_tac (see Provers/nat_transitive.ML) to automate arithmetic.
nipkow
parents:
2083
diff
changeset
|
54 |
setloop (split_tac [expand_if,expand_nat_case])) 1); |
73bbf2cc7651
Used trans_tac (see Provers/nat_transitive.ML) to automate arithmetic.
nipkow
parents:
2083
diff
changeset
|
55 |
by (safe_tac (HOL_cs addSEs [nat_neqE])); |
73bbf2cc7651
Used trans_tac (see Provers/nat_transitive.ML) to automate arithmetic.
nipkow
parents:
2083
diff
changeset
|
56 |
by (ALLGOALS trans_tac); |
1269 | 57 |
qed "free_subst"; |
58 |
Addsimps [free_subst]; |
|
59 |
||
60 |
goal Eta.thy "!!s. s -e> t ==> !i. free t i = free s i"; |
|
1730 | 61 |
by (etac eta.induct 1); |
2159
e650a3f6f600
Used nat_trans_tac. New Eta. various smaller changes.
nipkow
parents:
2116
diff
changeset
|
62 |
by (ALLGOALS(asm_simp_tac (!simpset addcongs [conj_cong]))); |
1486 | 63 |
qed_spec_mp "free_eta"; |
1269 | 64 |
|
65 |
goal Eta.thy "!!s. [| s -e> t; ~free s i |] ==> ~free t i"; |
|
2031 | 66 |
by (asm_simp_tac (!simpset addsimps [free_eta]) 1); |
1269 | 67 |
qed "not_free_eta"; |
68 |
||
69 |
goal Eta.thy "!!s. s -e> t ==> !u i. s[u/i] -e> t[u/i]"; |
|
1730 | 70 |
by (etac eta.induct 1); |
2159
e650a3f6f600
Used nat_trans_tac. New Eta. various smaller changes.
nipkow
parents:
2116
diff
changeset
|
71 |
by (ALLGOALS(asm_simp_tac (!simpset addsimps [subst_subst RS sym]))); |
1486 | 72 |
qed_spec_mp "eta_subst"; |
1269 | 73 |
Addsimps [eta_subst]; |
74 |
||
1759
a42d6c537f4a
Added comparison with implicit rule Fun(lift s 0 @ Var 0) -e> s
nipkow
parents:
1730
diff
changeset
|
75 |
section "Confluence of -e>"; |
1269 | 76 |
|
1431 | 77 |
goalw Eta.thy [square_def,id_def] "square eta eta (eta^=) (eta^=)"; |
1730 | 78 |
by (rtac (impI RS allI RS allI) 1); |
2057 | 79 |
by (Simp_tac 1); |
1730 | 80 |
by (etac eta.induct 1); |
2159
e650a3f6f600
Used nat_trans_tac. New Eta. various smaller changes.
nipkow
parents:
2116
diff
changeset
|
81 |
by (slow_tac (!claset addIs [subst_not_free,eta_subst] |
2057 | 82 |
addIs [free_eta RS iffD1] addss !simpset) 1); |
2922 | 83 |
by (safe_tac (!claset)); |
84 |
by (blast_tac (!claset addSIs [eta_subst] addIs [free_eta RS iffD1]) 5); |
|
85 |
by (ALLGOALS Blast_tac); |
|
2159
e650a3f6f600
Used nat_trans_tac. New Eta. various smaller changes.
nipkow
parents:
2116
diff
changeset
|
86 |
qed "square_eta"; |
1269 | 87 |
|
88 |
goal Eta.thy "confluent(eta)"; |
|
2159
e650a3f6f600
Used nat_trans_tac. New Eta. various smaller changes.
nipkow
parents:
2116
diff
changeset
|
89 |
by (rtac (square_eta RS square_reflcl_confluent) 1); |
1269 | 90 |
qed "eta_confluent"; |
91 |
||
1759
a42d6c537f4a
Added comparison with implicit rule Fun(lift s 0 @ Var 0) -e> s
nipkow
parents:
1730
diff
changeset
|
92 |
section "Congruence rules for -e>>"; |
1269 | 93 |
|
2159
e650a3f6f600
Used nat_trans_tac. New Eta. various smaller changes.
nipkow
parents:
2116
diff
changeset
|
94 |
goal Eta.thy "!!s. s -e>> s' ==> Abs s -e>> Abs s'"; |
1465 | 95 |
by (etac rtrancl_induct 1); |
2891 | 96 |
by (ALLGOALS(blast_tac (!claset addIs [rtrancl_refl,rtrancl_into_rtrancl]))); |
2159
e650a3f6f600
Used nat_trans_tac. New Eta. various smaller changes.
nipkow
parents:
2116
diff
changeset
|
97 |
qed "rtrancl_eta_Abs"; |
1269 | 98 |
|
99 |
goal Eta.thy "!!s. s -e>> s' ==> s @ t -e>> s' @ t"; |
|
1465 | 100 |
by (etac rtrancl_induct 1); |
2891 | 101 |
by (ALLGOALS(blast_tac (!claset addIs [rtrancl_refl,rtrancl_into_rtrancl]))); |
1269 | 102 |
qed "rtrancl_eta_AppL"; |
103 |
||
104 |
goal Eta.thy "!!s. t -e>> t' ==> s @ t -e>> s @ t'"; |
|
1465 | 105 |
by (etac rtrancl_induct 1); |
2891 | 106 |
by (ALLGOALS(blast_tac (!claset addIs [rtrancl_refl,rtrancl_into_rtrancl]))); |
1269 | 107 |
qed "rtrancl_eta_AppR"; |
108 |
||
109 |
goal Eta.thy "!!s. [| s -e>> s'; t -e>> t' |] ==> s @ t -e>> s' @ t'"; |
|
2922 | 110 |
by (blast_tac (!claset addSIs [rtrancl_eta_AppL, rtrancl_eta_AppR] |
111 |
addIs [rtrancl_trans]) 1); |
|
1269 | 112 |
qed "rtrancl_eta_App"; |
113 |
||
1759
a42d6c537f4a
Added comparison with implicit rule Fun(lift s 0 @ Var 0) -e> s
nipkow
parents:
1730
diff
changeset
|
114 |
section "Commutation of -> and -e>"; |
1269 | 115 |
|
1730 | 116 |
goal Eta.thy "!!s t. s -> t ==> (!i. free t i --> free s i)"; |
117 |
by (etac beta.induct 1); |
|
2031 | 118 |
by (ALLGOALS(Asm_full_simp_tac)); |
1486 | 119 |
qed_spec_mp "free_beta"; |
1269 | 120 |
|
2159
e650a3f6f600
Used nat_trans_tac. New Eta. various smaller changes.
nipkow
parents:
2116
diff
changeset
|
121 |
goal Eta.thy "!!s t. s -> t ==> !u i. s[u/i] -> t[u/i]"; |
1730 | 122 |
by (etac beta.induct 1); |
2031 | 123 |
by (ALLGOALS(asm_full_simp_tac (!simpset addsimps [subst_subst RS sym]))); |
2159
e650a3f6f600
Used nat_trans_tac. New Eta. various smaller changes.
nipkow
parents:
2116
diff
changeset
|
124 |
qed_spec_mp "beta_subst"; |
e650a3f6f600
Used nat_trans_tac. New Eta. various smaller changes.
nipkow
parents:
2116
diff
changeset
|
125 |
AddIs [beta_subst]; |
1269 | 126 |
|
2159
e650a3f6f600
Used nat_trans_tac. New Eta. various smaller changes.
nipkow
parents:
2116
diff
changeset
|
127 |
goal Eta.thy "!i. t[Var i/i] = t[Var(i)/Suc i]"; |
e650a3f6f600
Used nat_trans_tac. New Eta. various smaller changes.
nipkow
parents:
2116
diff
changeset
|
128 |
by (dB.induct_tac "t" 1); |
e650a3f6f600
Used nat_trans_tac. New Eta. various smaller changes.
nipkow
parents:
2116
diff
changeset
|
129 |
by (ALLGOALS (asm_simp_tac (addsplit (!simpset)))); |
e650a3f6f600
Used nat_trans_tac. New Eta. various smaller changes.
nipkow
parents:
2116
diff
changeset
|
130 |
by(safe_tac (HOL_cs addSEs [nat_neqE])); |
e650a3f6f600
Used nat_trans_tac. New Eta. various smaller changes.
nipkow
parents:
2116
diff
changeset
|
131 |
by(ALLGOALS trans_tac); |
e650a3f6f600
Used nat_trans_tac. New Eta. various smaller changes.
nipkow
parents:
2116
diff
changeset
|
132 |
qed_spec_mp "subst_Var_Suc"; |
e650a3f6f600
Used nat_trans_tac. New Eta. various smaller changes.
nipkow
parents:
2116
diff
changeset
|
133 |
Addsimps [subst_Var_Suc]; |
1269 | 134 |
|
1730 | 135 |
goal Eta.thy "!!s t. s -e> t ==> (!i. lift s i -e> lift t i)"; |
136 |
by (etac eta.induct 1); |
|
2159
e650a3f6f600
Used nat_trans_tac. New Eta. various smaller changes.
nipkow
parents:
2116
diff
changeset
|
137 |
by (ALLGOALS(asm_simp_tac (addsplit (!simpset)))); |
1486 | 138 |
qed_spec_mp "eta_lift"; |
1269 | 139 |
Addsimps [eta_lift]; |
140 |
||
141 |
goal Eta.thy "!s t i. s -e> t --> u[s/i] -e>> u[t/i]"; |
|
2159
e650a3f6f600
Used nat_trans_tac. New Eta. various smaller changes.
nipkow
parents:
2116
diff
changeset
|
142 |
by (dB.induct_tac "u" 1); |
2031 | 143 |
by (ALLGOALS(asm_simp_tac (addsplit (!simpset)))); |
2891 | 144 |
by (blast_tac (!claset addIs [r_into_rtrancl]) 1); |
145 |
by (blast_tac (!claset addSIs [rtrancl_eta_App]) 1); |
|
146 |
by (blast_tac (!claset addSIs [rtrancl_eta_Abs,eta_lift]) 1); |
|
1486 | 147 |
qed_spec_mp "rtrancl_eta_subst"; |
1269 | 148 |
|
149 |
goalw Eta.thy [square_def] "square beta eta (eta^*) (beta^=)"; |
|
1730 | 150 |
by (rtac (impI RS allI RS allI) 1); |
151 |
by (etac beta.induct 1); |
|
2159
e650a3f6f600
Used nat_trans_tac. New Eta. various smaller changes.
nipkow
parents:
2116
diff
changeset
|
152 |
by (slow_tac (!claset addIs [r_into_rtrancl,rtrancl_eta_subst,eta_subst] |
e650a3f6f600
Used nat_trans_tac. New Eta. various smaller changes.
nipkow
parents:
2116
diff
changeset
|
153 |
addss !simpset) 1); |
2922 | 154 |
by (Blast.depth_tac (!claset addIs [r_into_rtrancl,rtrancl_eta_AppL]) 6 1); |
155 |
by (Blast.depth_tac (!claset addIs [r_into_rtrancl,rtrancl_eta_AppR]) 6 1); |
|
156 |
(*23 seconds?*) |
|
2159
e650a3f6f600
Used nat_trans_tac. New Eta. various smaller changes.
nipkow
parents:
2116
diff
changeset
|
157 |
by (slow_tac (!claset addIs [r_into_rtrancl,rtrancl_eta_Abs,free_beta] |
e650a3f6f600
Used nat_trans_tac. New Eta. various smaller changes.
nipkow
parents:
2116
diff
changeset
|
158 |
addss !simpset) 1); |
1269 | 159 |
qed "square_beta_eta"; |
160 |
||
161 |
goal Eta.thy "confluent(beta Un eta)"; |
|
2031 | 162 |
by (REPEAT(ares_tac [square_rtrancl_reflcl_commute,confluent_Un, |
1269 | 163 |
beta_confluent,eta_confluent,square_beta_eta] 1)); |
164 |
qed "confluent_beta_eta"; |
|
1759
a42d6c537f4a
Added comparison with implicit rule Fun(lift s 0 @ Var 0) -e> s
nipkow
parents:
1730
diff
changeset
|
165 |
|
2159
e650a3f6f600
Used nat_trans_tac. New Eta. various smaller changes.
nipkow
parents:
2116
diff
changeset
|
166 |
section "Implicit definition of -e>: Abs(lift s 0 @ Var 0) -e> s"; |
1759
a42d6c537f4a
Added comparison with implicit rule Fun(lift s 0 @ Var 0) -e> s
nipkow
parents:
1730
diff
changeset
|
167 |
|
a42d6c537f4a
Added comparison with implicit rule Fun(lift s 0 @ Var 0) -e> s
nipkow
parents:
1730
diff
changeset
|
168 |
goal Eta.thy "!i. (~free s i) = (? t. s = lift t i)"; |
2159
e650a3f6f600
Used nat_trans_tac. New Eta. various smaller changes.
nipkow
parents:
2116
diff
changeset
|
169 |
by (dB.induct_tac "s" 1); |
2057 | 170 |
by (simp_tac (!simpset setloop (split_tac [expand_if])) 1); |
171 |
by (SELECT_GOAL(safe_tac HOL_cs)1); |
|
2159
e650a3f6f600
Used nat_trans_tac. New Eta. various smaller changes.
nipkow
parents:
2116
diff
changeset
|
172 |
by(etac nat_neqE 1); |
e650a3f6f600
Used nat_trans_tac. New Eta. various smaller changes.
nipkow
parents:
2116
diff
changeset
|
173 |
by (res_inst_tac [("x","Var nat")] exI 1); |
e650a3f6f600
Used nat_trans_tac. New Eta. various smaller changes.
nipkow
parents:
2116
diff
changeset
|
174 |
by (Asm_simp_tac 1); |
2057 | 175 |
by (res_inst_tac [("x","Var(pred nat)")] exI 1); |
176 |
by (Asm_simp_tac 1); |
|
177 |
by (rtac notE 1); |
|
178 |
by (assume_tac 2); |
|
179 |
by (etac thin_rl 1); |
|
2159
e650a3f6f600
Used nat_trans_tac. New Eta. various smaller changes.
nipkow
parents:
2116
diff
changeset
|
180 |
by (res_inst_tac [("dB","t")] dB_case_distinction 1); |
2057 | 181 |
by (simp_tac (!simpset setloop (split_tac [expand_if])) 1); |
2891 | 182 |
by (blast_tac (HOL_cs addDs [less_not_refl2]) 1); |
2057 | 183 |
by (Simp_tac 1); |
184 |
by (Simp_tac 1); |
|
2116
73bbf2cc7651
Used trans_tac (see Provers/nat_transitive.ML) to automate arithmetic.
nipkow
parents:
2083
diff
changeset
|
185 |
by (Asm_simp_tac 1); |
2057 | 186 |
by (etac thin_rl 1); |
187 |
by (etac thin_rl 1); |
|
188 |
by (rtac allI 1); |
|
189 |
by (rtac iffI 1); |
|
190 |
by (REPEAT(eresolve_tac [conjE,exE] 1)); |
|
191 |
by (rename_tac "u1 u2" 1); |
|
192 |
by (res_inst_tac [("x","u1@u2")] exI 1); |
|
193 |
by (Asm_simp_tac 1); |
|
194 |
by (etac exE 1); |
|
195 |
by (etac rev_mp 1); |
|
2159
e650a3f6f600
Used nat_trans_tac. New Eta. various smaller changes.
nipkow
parents:
2116
diff
changeset
|
196 |
by (res_inst_tac [("dB","t")] dB_case_distinction 1); |
2057 | 197 |
by (simp_tac (!simpset setloop (split_tac [expand_if])) 1); |
198 |
by (Simp_tac 1); |
|
2891 | 199 |
by (Blast_tac 1); |
2057 | 200 |
by (Simp_tac 1); |
2031 | 201 |
by (Asm_simp_tac 1); |
202 |
by (etac thin_rl 1); |
|
203 |
by (rtac allI 1); |
|
204 |
by (rtac iffI 1); |
|
2057 | 205 |
by (etac exE 1); |
2159
e650a3f6f600
Used nat_trans_tac. New Eta. various smaller changes.
nipkow
parents:
2116
diff
changeset
|
206 |
by (res_inst_tac [("x","Abs t")] exI 1); |
2057 | 207 |
by (Asm_simp_tac 1); |
2031 | 208 |
by (etac exE 1); |
209 |
by (etac rev_mp 1); |
|
2159
e650a3f6f600
Used nat_trans_tac. New Eta. various smaller changes.
nipkow
parents:
2116
diff
changeset
|
210 |
by (res_inst_tac [("dB","t")] dB_case_distinction 1); |
2057 | 211 |
by (simp_tac (!simpset setloop (split_tac [expand_if])) 1); |
212 |
by (Simp_tac 1); |
|
2031 | 213 |
by (Simp_tac 1); |
2891 | 214 |
by (Blast_tac 1); |
1759
a42d6c537f4a
Added comparison with implicit rule Fun(lift s 0 @ Var 0) -e> s
nipkow
parents:
1730
diff
changeset
|
215 |
qed_spec_mp "not_free_iff_lifted"; |
a42d6c537f4a
Added comparison with implicit rule Fun(lift s 0 @ Var 0) -e> s
nipkow
parents:
1730
diff
changeset
|
216 |
|
2159
e650a3f6f600
Used nat_trans_tac. New Eta. various smaller changes.
nipkow
parents:
2116
diff
changeset
|
217 |
goal Eta.thy "(!s u. (~free s 0) --> R(Abs(s @ Var 0))(s[u/0])) = \ |
e650a3f6f600
Used nat_trans_tac. New Eta. various smaller changes.
nipkow
parents:
2116
diff
changeset
|
218 |
\ (!s. R(Abs(lift s 0 @ Var 0))(s))"; |
e650a3f6f600
Used nat_trans_tac. New Eta. various smaller changes.
nipkow
parents:
2116
diff
changeset
|
219 |
by (fast_tac (HOL_cs addss (!simpset addsimps [not_free_iff_lifted])) 1); |
1759
a42d6c537f4a
Added comparison with implicit rule Fun(lift s 0 @ Var 0) -e> s
nipkow
parents:
1730
diff
changeset
|
220 |
qed "explicit_is_implicit"; |