author | paulson |
Wed, 28 Jun 2000 10:54:21 +0200 | |
changeset 9169 | 85a47aa21f74 |
parent 4721 | c8a8482a8124 |
child 9245 | 428385c4bc50 |
permissions | -rw-r--r-- |
2640 | 1 |
(* Title: HOLCF/Ssum2.ML |
243
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
2 |
ID: $Id$ |
1461 | 3 |
Author: Franz Regensburger |
243
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
4 |
Copyright 1993 Technische Universitaet Muenchen |
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
5 |
|
9169 | 6 |
Class Instance ++::(pcpo,pcpo)po |
243
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
7 |
*) |
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
8 |
|
2640 | 9 |
(* for compatibility with old HOLCF-Version *) |
9169 | 10 |
Goal "(op <<)=(%s1 s2.@z.\ |
3842 | 11 |
\ (! u x. s1=Isinl u & s2=Isinl x --> z = u << x)\ |
12 |
\ &(! v y. s1=Isinr v & s2=Isinr y --> z = v << y)\ |
|
13 |
\ &(! u y. s1=Isinl u & s2=Isinr y --> z = (u = UU))\ |
|
9169 | 14 |
\ &(! v x. s1=Isinr v & s2=Isinl x --> z = (v = UU)))"; |
15 |
by (fold_goals_tac [less_ssum_def]); |
|
16 |
by (rtac refl 1); |
|
17 |
qed "inst_ssum_po"; |
|
2640 | 18 |
|
243
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
19 |
(* ------------------------------------------------------------------------ *) |
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
20 |
(* access to less_ssum in class po *) |
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
21 |
(* ------------------------------------------------------------------------ *) |
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
22 |
|
9169 | 23 |
Goal "Isinl x << Isinl y = x << y"; |
24 |
by (simp_tac (simpset() addsimps [less_ssum2a]) 1); |
|
25 |
qed "less_ssum3a"; |
|
243
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
26 |
|
9169 | 27 |
Goal "Isinr x << Isinr y = x << y"; |
28 |
by (simp_tac (simpset() addsimps [less_ssum2b]) 1); |
|
29 |
qed "less_ssum3b"; |
|
243
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
30 |
|
9169 | 31 |
Goal "Isinl x << Isinr y = (x = UU)"; |
32 |
by (simp_tac (simpset() addsimps [less_ssum2c]) 1); |
|
33 |
qed "less_ssum3c"; |
|
243
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
34 |
|
9169 | 35 |
Goal "Isinr x << Isinl y = (x = UU)"; |
36 |
by (simp_tac (simpset() addsimps [less_ssum2d]) 1); |
|
37 |
qed "less_ssum3d"; |
|
243
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
38 |
|
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
39 |
(* ------------------------------------------------------------------------ *) |
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
40 |
(* type ssum ++ is pointed *) |
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
41 |
(* ------------------------------------------------------------------------ *) |
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
42 |
|
9169 | 43 |
Goal "Isinl UU << s"; |
44 |
by (res_inst_tac [("p","s")] IssumE2 1); |
|
45 |
by (hyp_subst_tac 1); |
|
46 |
by (rtac (less_ssum3a RS iffD2) 1); |
|
47 |
by (rtac minimal 1); |
|
48 |
by (hyp_subst_tac 1); |
|
49 |
by (stac strict_IsinlIsinr 1); |
|
50 |
by (rtac (less_ssum3b RS iffD2) 1); |
|
51 |
by (rtac minimal 1); |
|
52 |
qed "minimal_ssum"; |
|
243
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
53 |
|
2640 | 54 |
bind_thm ("UU_ssum_def",minimal_ssum RS minimal2UU RS sym); |
55 |
||
9169 | 56 |
Goal "? x::'a++'b.!y. x<<y"; |
57 |
by (res_inst_tac [("x","Isinl UU")] exI 1); |
|
58 |
by (rtac (minimal_ssum RS allI) 1); |
|
59 |
qed "least_ssum"; |
|
243
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
60 |
|
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
61 |
(* ------------------------------------------------------------------------ *) |
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
62 |
(* Isinl, Isinr are monotone *) |
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
63 |
(* ------------------------------------------------------------------------ *) |
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
64 |
|
2640 | 65 |
qed_goalw "monofun_Isinl" thy [monofun] "monofun(Isinl)" |
243
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
66 |
(fn prems => |
1461 | 67 |
[ |
68 |
(strip_tac 1), |
|
69 |
(etac (less_ssum3a RS iffD2) 1) |
|
70 |
]); |
|
243
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
71 |
|
2640 | 72 |
qed_goalw "monofun_Isinr" thy [monofun] "monofun(Isinr)" |
243
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
73 |
(fn prems => |
1461 | 74 |
[ |
75 |
(strip_tac 1), |
|
76 |
(etac (less_ssum3b RS iffD2) 1) |
|
77 |
]); |
|
243
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
78 |
|
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
79 |
|
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
80 |
(* ------------------------------------------------------------------------ *) |
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
81 |
(* Iwhen is monotone in all arguments *) |
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
82 |
(* ------------------------------------------------------------------------ *) |
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
83 |
|
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
84 |
|
2640 | 85 |
qed_goalw "monofun_Iwhen1" thy [monofun] "monofun(Iwhen)" |
243
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
86 |
(fn prems => |
1461 | 87 |
[ |
88 |
(strip_tac 1), |
|
89 |
(rtac (less_fun RS iffD2) 1), |
|
90 |
(strip_tac 1), |
|
91 |
(rtac (less_fun RS iffD2) 1), |
|
92 |
(strip_tac 1), |
|
93 |
(res_inst_tac [("p","xb")] IssumE 1), |
|
94 |
(hyp_subst_tac 1), |
|
1277
caef3601c0b2
corrected some errors that occurred after introduction of local simpsets
regensbu
parents:
1267
diff
changeset
|
95 |
(asm_simp_tac Ssum0_ss 1), |
caef3601c0b2
corrected some errors that occurred after introduction of local simpsets
regensbu
parents:
1267
diff
changeset
|
96 |
(asm_simp_tac Ssum0_ss 1), |
caef3601c0b2
corrected some errors that occurred after introduction of local simpsets
regensbu
parents:
1267
diff
changeset
|
97 |
(etac monofun_cfun_fun 1), |
caef3601c0b2
corrected some errors that occurred after introduction of local simpsets
regensbu
parents:
1267
diff
changeset
|
98 |
(asm_simp_tac Ssum0_ss 1) |
1461 | 99 |
]); |
243
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
100 |
|
2640 | 101 |
qed_goalw "monofun_Iwhen2" thy [monofun] "monofun(Iwhen(f))" |
243
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
102 |
(fn prems => |
1461 | 103 |
[ |
104 |
(strip_tac 1), |
|
105 |
(rtac (less_fun RS iffD2) 1), |
|
106 |
(strip_tac 1), |
|
107 |
(res_inst_tac [("p","xa")] IssumE 1), |
|
108 |
(hyp_subst_tac 1), |
|
1277
caef3601c0b2
corrected some errors that occurred after introduction of local simpsets
regensbu
parents:
1267
diff
changeset
|
109 |
(asm_simp_tac Ssum0_ss 1), |
caef3601c0b2
corrected some errors that occurred after introduction of local simpsets
regensbu
parents:
1267
diff
changeset
|
110 |
(asm_simp_tac Ssum0_ss 1), |
caef3601c0b2
corrected some errors that occurred after introduction of local simpsets
regensbu
parents:
1267
diff
changeset
|
111 |
(asm_simp_tac Ssum0_ss 1), |
1461 | 112 |
(etac monofun_cfun_fun 1) |
113 |
]); |
|
243
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
114 |
|
2640 | 115 |
qed_goalw "monofun_Iwhen3" thy [monofun] "monofun(Iwhen(f)(g))" |
243
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
116 |
(fn prems => |
1461 | 117 |
[ |
118 |
(strip_tac 1), |
|
119 |
(res_inst_tac [("p","x")] IssumE 1), |
|
120 |
(hyp_subst_tac 1), |
|
1277
caef3601c0b2
corrected some errors that occurred after introduction of local simpsets
regensbu
parents:
1267
diff
changeset
|
121 |
(asm_simp_tac Ssum0_ss 1), |
1461 | 122 |
(hyp_subst_tac 1), |
123 |
(res_inst_tac [("p","y")] IssumE 1), |
|
124 |
(hyp_subst_tac 1), |
|
1277
caef3601c0b2
corrected some errors that occurred after introduction of local simpsets
regensbu
parents:
1267
diff
changeset
|
125 |
(asm_simp_tac Ssum0_ss 1), |
1461 | 126 |
(res_inst_tac [("P","xa=UU")] notE 1), |
127 |
(atac 1), |
|
128 |
(rtac UU_I 1), |
|
129 |
(rtac (less_ssum3a RS iffD1) 1), |
|
130 |
(atac 1), |
|
131 |
(hyp_subst_tac 1), |
|
1277
caef3601c0b2
corrected some errors that occurred after introduction of local simpsets
regensbu
parents:
1267
diff
changeset
|
132 |
(asm_simp_tac Ssum0_ss 1), |
1461 | 133 |
(rtac monofun_cfun_arg 1), |
134 |
(etac (less_ssum3a RS iffD1) 1), |
|
135 |
(hyp_subst_tac 1), |
|
136 |
(res_inst_tac [("s","UU"),("t","xa")] subst 1), |
|
137 |
(etac (less_ssum3c RS iffD1 RS sym) 1), |
|
1277
caef3601c0b2
corrected some errors that occurred after introduction of local simpsets
regensbu
parents:
1267
diff
changeset
|
138 |
(asm_simp_tac Ssum0_ss 1), |
1461 | 139 |
(hyp_subst_tac 1), |
140 |
(res_inst_tac [("p","y")] IssumE 1), |
|
141 |
(hyp_subst_tac 1), |
|
142 |
(res_inst_tac [("s","UU"),("t","ya")] subst 1), |
|
143 |
(etac (less_ssum3d RS iffD1 RS sym) 1), |
|
1277
caef3601c0b2
corrected some errors that occurred after introduction of local simpsets
regensbu
parents:
1267
diff
changeset
|
144 |
(asm_simp_tac Ssum0_ss 1), |
1461 | 145 |
(hyp_subst_tac 1), |
146 |
(res_inst_tac [("s","UU"),("t","ya")] subst 1), |
|
147 |
(etac (less_ssum3d RS iffD1 RS sym) 1), |
|
1277
caef3601c0b2
corrected some errors that occurred after introduction of local simpsets
regensbu
parents:
1267
diff
changeset
|
148 |
(asm_simp_tac Ssum0_ss 1), |
1461 | 149 |
(hyp_subst_tac 1), |
1277
caef3601c0b2
corrected some errors that occurred after introduction of local simpsets
regensbu
parents:
1267
diff
changeset
|
150 |
(asm_simp_tac Ssum0_ss 1), |
1461 | 151 |
(rtac monofun_cfun_arg 1), |
152 |
(etac (less_ssum3b RS iffD1) 1) |
|
153 |
]); |
|
243
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
154 |
|
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
155 |
|
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
156 |
(* ------------------------------------------------------------------------ *) |
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
157 |
(* some kind of exhaustion rules for chains in 'a ++ 'b *) |
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
158 |
(* ------------------------------------------------------------------------ *) |
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
159 |
|
9169 | 160 |
Goal "[|~(!i.? x. Y(i::nat)=Isinl(x))|] ==> (? i.! x. Y(i)~=Isinl(x))"; |
161 |
by (fast_tac HOL_cs 1); |
|
162 |
qed "ssum_lemma1"; |
|
243
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
163 |
|
9169 | 164 |
Goal "[|(? i.!x.(Y::nat => 'a++'b)(i::nat)~=Isinl(x::'a))|] \ |
165 |
\ ==> (? i y. (Y::nat => 'a++'b)(i::nat)=Isinr(y::'b) & y~=UU)"; |
|
166 |
by (etac exE 1); |
|
167 |
by (res_inst_tac [("p","Y(i)")] IssumE 1); |
|
168 |
by (dtac spec 1); |
|
169 |
by (contr_tac 1); |
|
170 |
by (dtac spec 1); |
|
171 |
by (contr_tac 1); |
|
172 |
by (fast_tac HOL_cs 1); |
|
173 |
qed "ssum_lemma2"; |
|
243
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
174 |
|
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
175 |
|
9169 | 176 |
Goal "[|chain(Y);(? i x. Y(i)=Isinr(x::'b) & (x::'b)~=UU)|] \ |
177 |
\ ==> (!i.? y. Y(i)=Isinr(y))"; |
|
178 |
by (etac exE 1); |
|
179 |
by (etac exE 1); |
|
180 |
by (rtac allI 1); |
|
181 |
by (res_inst_tac [("p","Y(ia)")] IssumE 1); |
|
182 |
by (rtac exI 1); |
|
183 |
by (rtac trans 1); |
|
184 |
by (rtac strict_IsinlIsinr 2); |
|
185 |
by (atac 1); |
|
186 |
by (etac exI 2); |
|
187 |
by (etac conjE 1); |
|
188 |
by (res_inst_tac [("m","i"),("n","ia")] nat_less_cases 1); |
|
189 |
by (hyp_subst_tac 2); |
|
190 |
by (etac exI 2); |
|
191 |
by (eres_inst_tac [("P","x=UU")] notE 1); |
|
192 |
by (rtac (less_ssum3d RS iffD1) 1); |
|
193 |
by (eres_inst_tac [("s","Y(i)"),("t","Isinr(x)::'a++'b")] subst 1); |
|
194 |
by (eres_inst_tac [("s","Y(ia)"),("t","Isinl(xa)::'a++'b")] subst 1); |
|
195 |
by (etac (chain_mono RS mp) 1); |
|
196 |
by (atac 1); |
|
197 |
by (eres_inst_tac [("P","xa=UU")] notE 1); |
|
198 |
by (rtac (less_ssum3c RS iffD1) 1); |
|
199 |
by (eres_inst_tac [("s","Y(i)"),("t","Isinr(x)::'a++'b")] subst 1); |
|
200 |
by (eres_inst_tac [("s","Y(ia)"),("t","Isinl(xa)::'a++'b")] subst 1); |
|
201 |
by (etac (chain_mono RS mp) 1); |
|
202 |
by (atac 1); |
|
203 |
qed "ssum_lemma3"; |
|
243
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
204 |
|
9169 | 205 |
Goal "chain(Y) ==> (!i.? x. Y(i)=Isinl(x))|(!i.? y. Y(i)=Isinr(y))"; |
206 |
by (rtac case_split_thm 1); |
|
207 |
by (etac disjI1 1); |
|
208 |
by (rtac disjI2 1); |
|
209 |
by (etac ssum_lemma3 1); |
|
210 |
by (rtac ssum_lemma2 1); |
|
211 |
by (etac ssum_lemma1 1); |
|
212 |
qed "ssum_lemma4"; |
|
243
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
213 |
|
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
214 |
|
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
215 |
(* ------------------------------------------------------------------------ *) |
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
216 |
(* restricted surjectivity of Isinl *) |
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
217 |
(* ------------------------------------------------------------------------ *) |
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
218 |
|
9169 | 219 |
Goal "z=Isinl(x)==> Isinl((Iwhen (LAM x. x) (LAM y. UU))(z)) = z"; |
220 |
by (hyp_subst_tac 1); |
|
221 |
by (case_tac "x=UU" 1); |
|
222 |
by (asm_simp_tac Ssum0_ss 1); |
|
223 |
by (asm_simp_tac Ssum0_ss 1); |
|
224 |
qed "ssum_lemma5"; |
|
243
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
225 |
|
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
226 |
(* ------------------------------------------------------------------------ *) |
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
227 |
(* restricted surjectivity of Isinr *) |
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
228 |
(* ------------------------------------------------------------------------ *) |
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
229 |
|
9169 | 230 |
Goal "z=Isinr(x)==> Isinr((Iwhen (LAM y. UU) (LAM x. x))(z)) = z"; |
231 |
by (hyp_subst_tac 1); |
|
232 |
by (case_tac "x=UU" 1); |
|
233 |
by (asm_simp_tac Ssum0_ss 1); |
|
234 |
by (asm_simp_tac Ssum0_ss 1); |
|
235 |
qed "ssum_lemma6"; |
|
243
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
236 |
|
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
237 |
(* ------------------------------------------------------------------------ *) |
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
238 |
(* technical lemmas *) |
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
239 |
(* ------------------------------------------------------------------------ *) |
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
240 |
|
9169 | 241 |
Goal "[|Isinl(x) << z; x~=UU|] ==> ? y. z=Isinl(y) & y~=UU"; |
242 |
by (res_inst_tac [("p","z")] IssumE 1); |
|
243 |
by (hyp_subst_tac 1); |
|
244 |
by (etac notE 1); |
|
245 |
by (rtac antisym_less 1); |
|
246 |
by (etac (less_ssum3a RS iffD1) 1); |
|
247 |
by (rtac minimal 1); |
|
248 |
by (fast_tac HOL_cs 1); |
|
249 |
by (hyp_subst_tac 1); |
|
250 |
by (rtac notE 1); |
|
251 |
by (etac (less_ssum3c RS iffD1) 2); |
|
252 |
by (atac 1); |
|
253 |
qed "ssum_lemma7"; |
|
243
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
254 |
|
9169 | 255 |
Goal "[|Isinr(x) << z; x~=UU|] ==> ? y. z=Isinr(y) & y~=UU"; |
256 |
by (res_inst_tac [("p","z")] IssumE 1); |
|
257 |
by (hyp_subst_tac 1); |
|
258 |
by (etac notE 1); |
|
259 |
by (etac (less_ssum3d RS iffD1) 1); |
|
260 |
by (hyp_subst_tac 1); |
|
261 |
by (rtac notE 1); |
|
262 |
by (etac (less_ssum3d RS iffD1) 2); |
|
263 |
by (atac 1); |
|
264 |
by (fast_tac HOL_cs 1); |
|
265 |
qed "ssum_lemma8"; |
|
243
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
266 |
|
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
267 |
(* ------------------------------------------------------------------------ *) |
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
268 |
(* the type 'a ++ 'b is a cpo in three steps *) |
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
269 |
(* ------------------------------------------------------------------------ *) |
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
270 |
|
9169 | 271 |
Goal "[|chain(Y);(!i.? x. Y(i)=Isinl(x))|] ==>\ |
272 |
\ range(Y) <<| Isinl(lub(range(%i.(Iwhen (LAM x. x) (LAM y. UU))(Y i))))"; |
|
273 |
by (rtac is_lubI 1); |
|
274 |
by (rtac conjI 1); |
|
275 |
by (rtac ub_rangeI 1); |
|
276 |
by (rtac allI 1); |
|
277 |
by (etac allE 1); |
|
278 |
by (etac exE 1); |
|
279 |
by (res_inst_tac [("t","Y(i)")] (ssum_lemma5 RS subst) 1); |
|
280 |
by (atac 1); |
|
281 |
by (rtac (monofun_Isinl RS monofunE RS spec RS spec RS mp) 1); |
|
282 |
by (rtac is_ub_thelub 1); |
|
283 |
by (etac (monofun_Iwhen3 RS ch2ch_monofun) 1); |
|
284 |
by (strip_tac 1); |
|
285 |
by (res_inst_tac [("p","u")] IssumE2 1); |
|
286 |
by (res_inst_tac [("t","u")] (ssum_lemma5 RS subst) 1); |
|
287 |
by (atac 1); |
|
288 |
by (rtac (monofun_Isinl RS monofunE RS spec RS spec RS mp) 1); |
|
289 |
by (rtac is_lub_thelub 1); |
|
290 |
by (etac (monofun_Iwhen3 RS ch2ch_monofun) 1); |
|
291 |
by (etac (monofun_Iwhen3 RS ub2ub_monofun) 1); |
|
292 |
by (hyp_subst_tac 1); |
|
293 |
by (rtac (less_ssum3c RS iffD2) 1); |
|
294 |
by (rtac chain_UU_I_inverse 1); |
|
295 |
by (rtac allI 1); |
|
296 |
by (res_inst_tac [("p","Y(i)")] IssumE 1); |
|
297 |
by (asm_simp_tac Ssum0_ss 1); |
|
298 |
by (asm_simp_tac Ssum0_ss 2); |
|
299 |
by (etac notE 1); |
|
300 |
by (rtac (less_ssum3c RS iffD1) 1); |
|
301 |
by (res_inst_tac [("t","Isinl(x)")] subst 1); |
|
302 |
by (atac 1); |
|
303 |
by (etac (ub_rangeE RS spec) 1); |
|
304 |
qed "lub_ssum1a"; |
|
243
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
305 |
|
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
306 |
|
9169 | 307 |
Goal "[|chain(Y);(!i.? x. Y(i)=Isinr(x))|] ==>\ |
308 |
\ range(Y) <<| Isinr(lub(range(%i.(Iwhen (LAM y. UU) (LAM x. x))(Y i))))"; |
|
309 |
by (rtac is_lubI 1); |
|
310 |
by (rtac conjI 1); |
|
311 |
by (rtac ub_rangeI 1); |
|
312 |
by (rtac allI 1); |
|
313 |
by (etac allE 1); |
|
314 |
by (etac exE 1); |
|
315 |
by (res_inst_tac [("t","Y(i)")] (ssum_lemma6 RS subst) 1); |
|
316 |
by (atac 1); |
|
317 |
by (rtac (monofun_Isinr RS monofunE RS spec RS spec RS mp) 1); |
|
318 |
by (rtac is_ub_thelub 1); |
|
319 |
by (etac (monofun_Iwhen3 RS ch2ch_monofun) 1); |
|
320 |
by (strip_tac 1); |
|
321 |
by (res_inst_tac [("p","u")] IssumE2 1); |
|
322 |
by (hyp_subst_tac 1); |
|
323 |
by (rtac (less_ssum3d RS iffD2) 1); |
|
324 |
by (rtac chain_UU_I_inverse 1); |
|
325 |
by (rtac allI 1); |
|
326 |
by (res_inst_tac [("p","Y(i)")] IssumE 1); |
|
327 |
by (asm_simp_tac Ssum0_ss 1); |
|
328 |
by (asm_simp_tac Ssum0_ss 1); |
|
329 |
by (etac notE 1); |
|
330 |
by (rtac (less_ssum3d RS iffD1) 1); |
|
331 |
by (res_inst_tac [("t","Isinr(y)")] subst 1); |
|
332 |
by (atac 1); |
|
333 |
by (etac (ub_rangeE RS spec) 1); |
|
334 |
by (res_inst_tac [("t","u")] (ssum_lemma6 RS subst) 1); |
|
335 |
by (atac 1); |
|
336 |
by (rtac (monofun_Isinr RS monofunE RS spec RS spec RS mp) 1); |
|
337 |
by (rtac is_lub_thelub 1); |
|
338 |
by (etac (monofun_Iwhen3 RS ch2ch_monofun) 1); |
|
339 |
by (etac (monofun_Iwhen3 RS ub2ub_monofun) 1); |
|
340 |
qed "lub_ssum1b"; |
|
243
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
341 |
|
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
342 |
|
1779 | 343 |
bind_thm ("thelub_ssum1a", lub_ssum1a RS thelubI); |
1168
74be52691d62
The curried version of HOLCF is now just called HOLCF. The old
regensbu
parents:
961
diff
changeset
|
344 |
(* |
4721
c8a8482a8124
renamed is_chain to chain, is_tord to tord, replaced chain_finite by chfin
oheimb
parents:
4098
diff
changeset
|
345 |
[| chain ?Y1; ! i. ? x. ?Y1 i = Isinl x |] ==> |
1168
74be52691d62
The curried version of HOLCF is now just called HOLCF. The old
regensbu
parents:
961
diff
changeset
|
346 |
lub (range ?Y1) = Isinl |
74be52691d62
The curried version of HOLCF is now just called HOLCF. The old
regensbu
parents:
961
diff
changeset
|
347 |
(lub (range (%i. Iwhen (LAM x. x) (LAM y. UU) (?Y1 i)))) |
74be52691d62
The curried version of HOLCF is now just called HOLCF. The old
regensbu
parents:
961
diff
changeset
|
348 |
*) |
243
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
349 |
|
1779 | 350 |
bind_thm ("thelub_ssum1b", lub_ssum1b RS thelubI); |
1168
74be52691d62
The curried version of HOLCF is now just called HOLCF. The old
regensbu
parents:
961
diff
changeset
|
351 |
(* |
4721
c8a8482a8124
renamed is_chain to chain, is_tord to tord, replaced chain_finite by chfin
oheimb
parents:
4098
diff
changeset
|
352 |
[| chain ?Y1; ! i. ? x. ?Y1 i = Isinr x |] ==> |
1168
74be52691d62
The curried version of HOLCF is now just called HOLCF. The old
regensbu
parents:
961
diff
changeset
|
353 |
lub (range ?Y1) = Isinr |
74be52691d62
The curried version of HOLCF is now just called HOLCF. The old
regensbu
parents:
961
diff
changeset
|
354 |
(lub (range (%i. Iwhen (LAM y. UU) (LAM x. x) (?Y1 i)))) |
74be52691d62
The curried version of HOLCF is now just called HOLCF. The old
regensbu
parents:
961
diff
changeset
|
355 |
*) |
243
c22b85994e17
Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff
changeset
|
356 |
|
9169 | 357 |
Goal "chain(Y::nat=>'a ++'b) ==> ? x. range(Y) <<|x"; |
358 |
by (rtac (ssum_lemma4 RS disjE) 1); |
|
359 |
by (atac 1); |
|
360 |
by (rtac exI 1); |
|
361 |
by (etac lub_ssum1a 1); |
|
362 |
by (atac 1); |
|
363 |
by (rtac exI 1); |
|
364 |
by (etac lub_ssum1b 1); |
|
365 |
by (atac 1); |
|
366 |
qed "cpo_ssum"; |
|
1168
74be52691d62
The curried version of HOLCF is now just called HOLCF. The old
regensbu
parents:
961
diff
changeset
|
367 |