author | nipkow |
Thu, 22 Jun 1995 12:45:08 +0200 | |
changeset 1153 | 5c5daf97cf2d |
parent 1124 | a6233ea105a4 |
child 1172 | ab725b698cb2 |
permissions | -rw-r--r-- |
1120 | 1 |
(* Title: HOL/Lambda.thy |
2 |
ID: $Id$ |
|
3 |
Author: Tobias Nipkow |
|
4 |
Copyright 1995 TU Muenchen |
|
5 |
||
6 |
Substitution-lemmas. Most of the proofs, esp. those about natural numbers, |
|
7 |
are ported from Ole Rasmussen's ZF development. In ZF, m<=n is syntactic |
|
8 |
sugar for m<Suc(n). In HOL <= is a separate operator. Hence we have to prove |
|
9 |
some compatibility lemmas. |
|
10 |
||
11 |
*) |
|
12 |
||
13 |
(*** Nat ***) |
|
14 |
||
15 |
goal Nat.thy "!!i. [| i < Suc j; j < k |] ==> i < k"; |
|
16 |
br le_less_trans 1; |
|
17 |
ba 2; |
|
18 |
by(asm_full_simp_tac (nat_ss addsimps [le_def]) 1); |
|
19 |
by(fast_tac (HOL_cs addEs [less_asym,less_anti_refl]) 1); |
|
20 |
qed "lt_trans1"; |
|
21 |
||
22 |
goal Nat.thy "!!i. [| i < j; j < Suc(k) |] ==> i < k"; |
|
23 |
be less_le_trans 1; |
|
24 |
by(asm_full_simp_tac (nat_ss addsimps [le_def]) 1); |
|
25 |
by(fast_tac (HOL_cs addEs [less_asym,less_anti_refl]) 1); |
|
26 |
qed "lt_trans2"; |
|
27 |
||
28 |
val major::prems = goal Nat.thy |
|
29 |
"[| i < Suc j; i < j ==> P; i = j ==> P |] ==> P"; |
|
30 |
br (major RS lessE) 1; |
|
31 |
by(ALLGOALS(asm_full_simp_tac nat_ss)); |
|
32 |
by(resolve_tac prems 1 THEN etac sym 1); |
|
33 |
by(fast_tac (HOL_cs addIs prems) 1); |
|
34 |
qed "leqE"; |
|
35 |
||
36 |
goal Arith.thy "!!i. i < j ==> Suc(pred j) = j"; |
|
37 |
by(fast_tac (HOL_cs addEs [lessE] addss arith_ss) 1); |
|
38 |
qed "Suc_pred"; |
|
39 |
||
40 |
goal Arith.thy "!!i. Suc i < j ==> i < pred j "; |
|
41 |
by (resolve_tac [Suc_less_SucD] 1); |
|
42 |
by (asm_simp_tac (arith_ss addsimps [Suc_pred]) 1); |
|
43 |
qed "lt_pred"; |
|
44 |
||
45 |
goal Arith.thy "!!i. [| i < Suc j; k < i |] ==> pred i < j "; |
|
46 |
by (resolve_tac [Suc_less_SucD] 1); |
|
47 |
by (asm_simp_tac (arith_ss addsimps [Suc_pred]) 1); |
|
48 |
qed "gt_pred"; |
|
49 |
||
1153 | 50 |
|
1120 | 51 |
(*** Lambda ***) |
52 |
||
53 |
open Lambda; |
|
54 |
||
55 |
val lambda_ss = arith_ss delsimps [less_Suc_eq] addsimps |
|
56 |
db.simps @ beta.intrs @ |
|
57 |
[if_not_P, not_less_eq, |
|
58 |
subst_App,subst_Fun, |
|
59 |
lift_Var,lift_App,lift_Fun]; |
|
60 |
||
61 |
val lambda_cs = HOL_cs addSIs beta.intrs; |
|
62 |
||
63 |
(*** Congruence rules for ->> ***) |
|
64 |
||
65 |
goal Lambda.thy "!!s. s ->> s' ==> Fun s ->> Fun s'"; |
|
66 |
be rtrancl_induct 1; |
|
67 |
by (ALLGOALS(fast_tac (lambda_cs addIs [rtrancl_refl,rtrancl_into_rtrancl]))); |
|
68 |
qed "rtrancl_beta_Fun"; |
|
69 |
||
70 |
goal Lambda.thy "!!s. s ->> s' ==> s @ t ->> s' @ t"; |
|
71 |
be rtrancl_induct 1; |
|
72 |
by (ALLGOALS(fast_tac (lambda_cs addIs [rtrancl_refl,rtrancl_into_rtrancl]))); |
|
73 |
qed "rtrancl_beta_AppL"; |
|
74 |
||
75 |
goal Lambda.thy "!!s. t ->> t' ==> s @ t ->> s @ t'"; |
|
76 |
be rtrancl_induct 1; |
|
77 |
by (ALLGOALS(fast_tac (lambda_cs addIs [rtrancl_refl,rtrancl_into_rtrancl]))); |
|
78 |
qed "rtrancl_beta_AppR"; |
|
79 |
||
80 |
goal Lambda.thy "!!s. [| s ->> s'; t ->> t' |] ==> s @ t ->> s' @ t'"; |
|
81 |
by (fast_tac (lambda_cs addIs |
|
1124
a6233ea105a4
Polished the presentation making it completely definitional.
nipkow
parents:
1120
diff
changeset
|
82 |
[rtrancl_beta_AppL,rtrancl_beta_AppR,rtrancl_trans]) 1); |
1120 | 83 |
qed "rtrancl_beta_App"; |
84 |
||
85 |
(*** subst and lift ***) |
|
86 |
||
87 |
fun addsplit ss = ss addsimps [subst_Var] setloop (split_tac [expand_if]); |
|
88 |
||
1153 | 89 |
goal Lambda.thy "(Var k)[u/k] = u"; |
1120 | 90 |
by (asm_full_simp_tac (addsplit lambda_ss) 1); |
91 |
qed "subst_eq"; |
|
92 |
||
1153 | 93 |
goal Lambda.thy "!!s. i<j ==> (Var j)[u/i] = Var(pred j)"; |
1120 | 94 |
by (asm_full_simp_tac (addsplit lambda_ss) 1); |
95 |
qed "subst_gt"; |
|
96 |
||
1153 | 97 |
goal Lambda.thy "!!s. j<i ==> (Var j)[u/i] = Var(j)"; |
1120 | 98 |
by (asm_full_simp_tac (addsplit lambda_ss addsimps |
99 |
[less_not_refl2 RS not_sym,less_SucI]) 1); |
|
100 |
qed "subst_lt"; |
|
101 |
||
102 |
val lambda_ss = lambda_ss addsimps [subst_eq,subst_gt,subst_lt]; |
|
103 |
||
104 |
goal Lambda.thy |
|
1153 | 105 |
"!i k. i < Suc k --> lift (lift s i) (Suc k) = lift (lift s k) i"; |
1120 | 106 |
by(db.induct_tac "s" 1); |
107 |
by(ALLGOALS(asm_simp_tac lambda_ss)); |
|
108 |
by(strip_tac 1); |
|
109 |
by (excluded_middle_tac "nat < i" 1); |
|
110 |
by ((forward_tac [lt_trans2] 2) THEN (assume_tac 2)); |
|
111 |
by (ALLGOALS(asm_full_simp_tac ((addsplit lambda_ss) addsimps [less_SucI]))); |
|
112 |
qed"lift_lift"; |
|
113 |
||
1153 | 114 |
goal Lambda.thy "!i j s. j < Suc i --> \ |
115 |
\ lift (t[s/j]) i = (lift t (Suc i)) [lift s i / j]"; |
|
1120 | 116 |
by(db.induct_tac "t" 1); |
117 |
by(ALLGOALS(asm_simp_tac (lambda_ss addsimps [lift_lift]))); |
|
118 |
by(strip_tac 1); |
|
1153 | 119 |
by (excluded_middle_tac "nat < j" 1); |
1120 | 120 |
by (asm_full_simp_tac lambda_ss 1); |
121 |
by (eres_inst_tac [("j","nat")] leqE 1); |
|
122 |
by (asm_full_simp_tac ((addsplit lambda_ss) |
|
123 |
addsimps [less_SucI,gt_pred,Suc_pred]) 1); |
|
124 |
by (hyp_subst_tac 1); |
|
125 |
by (asm_simp_tac lambda_ss 1); |
|
1153 | 126 |
by (forw_inst_tac [("j","j")] lt_trans2 1); |
1120 | 127 |
by (assume_tac 1); |
128 |
by (asm_full_simp_tac (addsplit lambda_ss addsimps [less_SucI]) 1); |
|
129 |
qed "lift_subst"; |
|
130 |
val lambda_ss = lambda_ss addsimps [lift_subst]; |
|
131 |
||
132 |
goal Lambda.thy |
|
1153 | 133 |
"!i j u. i < Suc j -->\ |
134 |
\ lift (v[u/j]) i = (lift v i) [lift u i / Suc j]"; |
|
1120 | 135 |
by(db.induct_tac "v" 1); |
136 |
by(ALLGOALS(asm_simp_tac (lambda_ss addsimps [lift_lift]))); |
|
137 |
by(strip_tac 1); |
|
1153 | 138 |
by (excluded_middle_tac "nat < j" 1); |
1120 | 139 |
by (asm_full_simp_tac lambda_ss 1); |
1153 | 140 |
by (eres_inst_tac [("i","j")] leqE 1); |
1120 | 141 |
by (forward_tac [lt_trans1] 1 THEN assume_tac 1); |
142 |
by (ALLGOALS(asm_full_simp_tac |
|
143 |
(lambda_ss addsimps [Suc_pred,less_SucI,gt_pred]))); |
|
144 |
by (hyp_subst_tac 1); |
|
145 |
by (asm_full_simp_tac (lambda_ss addsimps [less_SucI]) 1); |
|
146 |
by(split_tac [expand_if] 1); |
|
147 |
by (asm_full_simp_tac (lambda_ss addsimps [less_SucI]) 1); |
|
148 |
qed "lift_subst_lt"; |
|
149 |
||
1153 | 150 |
goal Lambda.thy "!k v. (lift u k)[v/k] = u"; |
1120 | 151 |
by(db.induct_tac "u" 1); |
152 |
by(ALLGOALS(asm_simp_tac lambda_ss)); |
|
153 |
by(split_tac [expand_if] 1); |
|
154 |
by(ALLGOALS(asm_full_simp_tac lambda_ss)); |
|
155 |
qed "subst_lift"; |
|
156 |
val lambda_ss = lambda_ss addsimps [subst_lift]; |
|
157 |
||
158 |
||
1153 | 159 |
goal Lambda.thy "!i j u w. i < Suc j --> \ |
160 |
\ (v[lift w i / Suc j]) [u[w/j]/i] = (v[u/i])[w/j]"; |
|
1120 | 161 |
by(db.induct_tac "v" 1); |
162 |
by (ALLGOALS(asm_simp_tac (lambda_ss addsimps |
|
163 |
[lift_lift RS spec RS spec RS mp RS sym,lift_subst_lt]))); |
|
164 |
by(strip_tac 1); |
|
1153 | 165 |
by (excluded_middle_tac "nat < Suc(Suc j)" 1); |
1120 | 166 |
by(asm_full_simp_tac lambda_ss 1); |
167 |
by (forward_tac [lessI RS less_trans] 1); |
|
168 |
by (eresolve_tac [leqE] 1); |
|
169 |
by (asm_simp_tac (lambda_ss addsimps [Suc_pred,lt_pred]) 2); |
|
170 |
by (forward_tac [Suc_mono RS less_trans] 1 THEN assume_tac 1); |
|
1153 | 171 |
by (forw_inst_tac [("i","i")] (lessI RS less_trans) 1); |
1120 | 172 |
by (asm_simp_tac (lambda_ss addsimps [Suc_pred,lt_pred]) 1); |
173 |
by (eres_inst_tac [("i","nat")] leqE 1); |
|
174 |
by (asm_full_simp_tac (lambda_ss addsimps [Suc_pred,less_SucI]) 2); |
|
1153 | 175 |
by (excluded_middle_tac "nat < i" 1); |
1120 | 176 |
by (asm_full_simp_tac lambda_ss 1); |
177 |
by (eres_inst_tac [("j","nat")] leqE 1); |
|
178 |
by (asm_simp_tac (lambda_ss addsimps [gt_pred]) 1); |
|
179 |
by (asm_simp_tac lambda_ss 1); |
|
180 |
by (forward_tac [lt_trans2] 1 THEN assume_tac 1); |
|
181 |
by (asm_simp_tac (lambda_ss addsimps [gt_pred]) 1); |
|
182 |
bind_thm("subst_subst", result() RS spec RS spec RS spec RS spec RS mp); |
|
1153 | 183 |
|
184 |
val lambda_ss = lambda_ss addsimps |
|
185 |
[liftn_Var,liftn_App,liftn_Fun,substn_Var,substn_App,substn_Fun]; |
|
186 |
||
187 |
(*** Equivalence proof for optimized substitution ***) |
|
188 |
||
189 |
goal Lambda.thy "!k. liftn 0 t k = t"; |
|
190 |
by(db.induct_tac "t" 1); |
|
191 |
by(ALLGOALS(asm_simp_tac (addsplit lambda_ss))); |
|
192 |
qed "liftn_0"; |
|
193 |
val lambda_ss = lambda_ss addsimps [liftn_0]; |
|
194 |
||
195 |
goal Lambda.thy "!k. liftn (Suc n) t k = lift (liftn n t k) k"; |
|
196 |
by(db.induct_tac "t" 1); |
|
197 |
by(ALLGOALS(asm_simp_tac (addsplit lambda_ss))); |
|
198 |
by(fast_tac (HOL_cs addDs [add_lessD1]) 1); |
|
199 |
qed "liftn_lift"; |
|
200 |
val lambda_ss = lambda_ss addsimps [liftn_lift]; |
|
201 |
||
202 |
goal Lambda.thy "!n. substn t s n = t[liftn n s 0 / n]"; |
|
203 |
by(db.induct_tac "t" 1); |
|
204 |
by(ALLGOALS(asm_simp_tac (addsplit lambda_ss))); |
|
205 |
qed "substn_subst_n"; |
|
206 |
val lambda_ss = lambda_ss addsimps [substn_subst_n]; |
|
207 |
||
208 |
goal Lambda.thy "substn t s 0 = t[s/0]"; |
|
209 |
by(simp_tac lambda_ss 1); |
|
210 |
qed "substn_subst_0"; |