author | wenzelm |
Thu, 14 Oct 1999 15:04:36 +0200 | |
changeset 7866 | 3ccaa11b6df9 |
parent 7499 | 23e090051cb8 |
child 9683 | f87c8c449018 |
permissions | -rw-r--r-- |
1461 | 1 |
(* Title: ZF/Coind/Map.ML |
915 | 2 |
ID: $Id$ |
1461 | 3 |
Author: Jacob Frost, Cambridge University Computer Laboratory |
915 | 4 |
Copyright 1995 University of Cambridge |
5 |
*) |
|
6 |
||
7 |
open Map; |
|
8 |
||
4841
d275fd349f3d
new thms, really demos of the final coalgebra theorem
paulson
parents:
4152
diff
changeset
|
9 |
(** Some sample proofs of inclusions for the final coalgebra "U" (by lcp) **) |
d275fd349f3d
new thms, really demos of the final coalgebra theorem
paulson
parents:
4152
diff
changeset
|
10 |
|
5265
9d1d4c43c76d
Disjointness reasoning by AddEs [equals0E, sym RS equals0E]
paulson
parents:
5147
diff
changeset
|
11 |
Goalw [TMap_def] "{0,1} <= {1} Un TMap(I, {0,1})"; |
4841
d275fd349f3d
new thms, really demos of the final coalgebra theorem
paulson
parents:
4152
diff
changeset
|
12 |
by (Blast_tac 1); |
d275fd349f3d
new thms, really demos of the final coalgebra theorem
paulson
parents:
4152
diff
changeset
|
13 |
result(); |
d275fd349f3d
new thms, really demos of the final coalgebra theorem
paulson
parents:
4152
diff
changeset
|
14 |
|
5265
9d1d4c43c76d
Disjointness reasoning by AddEs [equals0E, sym RS equals0E]
paulson
parents:
5147
diff
changeset
|
15 |
Goalw [TMap_def] "{0} Un TMap(I,1) <= {1} Un TMap(I, {0} Un TMap(I,1))"; |
4841
d275fd349f3d
new thms, really demos of the final coalgebra theorem
paulson
parents:
4152
diff
changeset
|
16 |
by (Blast_tac 1); |
d275fd349f3d
new thms, really demos of the final coalgebra theorem
paulson
parents:
4152
diff
changeset
|
17 |
result(); |
d275fd349f3d
new thms, really demos of the final coalgebra theorem
paulson
parents:
4152
diff
changeset
|
18 |
|
5265
9d1d4c43c76d
Disjointness reasoning by AddEs [equals0E, sym RS equals0E]
paulson
parents:
5147
diff
changeset
|
19 |
Goalw [TMap_def] "{0,1} Un TMap(I,2) <= {1} Un TMap(I, {0,1} Un TMap(I,2))"; |
4841
d275fd349f3d
new thms, really demos of the final coalgebra theorem
paulson
parents:
4152
diff
changeset
|
20 |
by (Blast_tac 1); |
d275fd349f3d
new thms, really demos of the final coalgebra theorem
paulson
parents:
4152
diff
changeset
|
21 |
result(); |
d275fd349f3d
new thms, really demos of the final coalgebra theorem
paulson
parents:
4152
diff
changeset
|
22 |
|
5265
9d1d4c43c76d
Disjointness reasoning by AddEs [equals0E, sym RS equals0E]
paulson
parents:
5147
diff
changeset
|
23 |
(*TOO SLOW |
5068 | 24 |
Goalw [TMap_def] |
4841
d275fd349f3d
new thms, really demos of the final coalgebra theorem
paulson
parents:
4152
diff
changeset
|
25 |
"{0,1} Un TMap(I,TMap(I,2)) Un TMap(I,2) <= \ |
d275fd349f3d
new thms, really demos of the final coalgebra theorem
paulson
parents:
4152
diff
changeset
|
26 |
\ {1} Un TMap(I, {0,1} Un TMap(I,TMap(I,2)) Un TMap(I,2))"; |
5265
9d1d4c43c76d
Disjointness reasoning by AddEs [equals0E, sym RS equals0E]
paulson
parents:
5147
diff
changeset
|
27 |
by (Blast_tac 1); |
4841
d275fd349f3d
new thms, really demos of the final coalgebra theorem
paulson
parents:
4152
diff
changeset
|
28 |
result(); |
5265
9d1d4c43c76d
Disjointness reasoning by AddEs [equals0E, sym RS equals0E]
paulson
parents:
5147
diff
changeset
|
29 |
*) |
4841
d275fd349f3d
new thms, really demos of the final coalgebra theorem
paulson
parents:
4152
diff
changeset
|
30 |
|
d275fd349f3d
new thms, really demos of the final coalgebra theorem
paulson
parents:
4152
diff
changeset
|
31 |
|
915 | 32 |
(* ############################################################ *) |
33 |
(* Lemmas *) |
|
34 |
(* ############################################################ *) |
|
35 |
||
6068 | 36 |
Goal "Sigma(A,B)``{a} = (if a:A then B(a) else 0)"; |
6046 | 37 |
by Auto_tac; |
38 |
qed "qbeta_if"; |
|
39 |
||
5137 | 40 |
Goal "a:A ==> Sigma(A,B)``{a} = B(a)"; |
2493 | 41 |
by (Fast_tac 1); |
915 | 42 |
qed "qbeta"; |
43 |
||
5137 | 44 |
Goal "a~:A ==> Sigma(A,B)``{a} = 0"; |
2493 | 45 |
by (Fast_tac 1); |
915 | 46 |
qed "qbeta_emp"; |
47 |
||
5137 | 48 |
Goal "a ~: A ==> Sigma(A,B)``{a}=0"; |
2493 | 49 |
by (Fast_tac 1); |
915 | 50 |
qed "image_Sigma1"; |
51 |
||
52 |
||
53 |
(* ############################################################ *) |
|
54 |
(* Inclusion in Quine Universes *) |
|
55 |
(* ############################################################ *) |
|
56 |
||
57 |
(* Lemmas *) |
|
58 |
||
5068 | 59 |
Goalw [quniv_def] |
5147
825877190618
More tidying and removal of "\!\!... from Goal commands
paulson
parents:
5143
diff
changeset
|
60 |
"A <= univ(X) ==> Pow(A * Union(quniv(X))) <= quniv(X)"; |
915 | 61 |
by (rtac Pow_mono 1); |
62 |
by (rtac ([Sigma_mono, product_univ] MRS subset_trans) 1); |
|
63 |
by (etac subset_trans 1); |
|
64 |
by (rtac (arg_subset_eclose RS univ_mono) 1); |
|
4091 | 65 |
by (simp_tac (simpset() addsimps [Union_Pow_eq]) 1); |
915 | 66 |
qed "MapQU_lemma"; |
67 |
||
68 |
(* Theorems *) |
|
69 |
||
70 |
val prems = goalw Map.thy [PMap_def,TMap_def] |
|
3840 | 71 |
"[| m:PMap(A,quniv(B)); !!x. x:A ==> x:univ(B) |] ==> m:quniv(B)"; |
915 | 72 |
by (cut_facts_tac prems 1); |
73 |
by (rtac (MapQU_lemma RS subsetD) 1); |
|
74 |
by (rtac subsetI 1); |
|
75 |
by (eresolve_tac prems 1); |
|
2469 | 76 |
by (Fast_tac 1); |
915 | 77 |
qed "mapQU"; |
78 |
||
79 |
(* ############################################################ *) |
|
80 |
(* Monotonicity *) |
|
81 |
(* ############################################################ *) |
|
82 |
||
5143
b94cd208f073
Removal of leading "\!\!..." from most Goal commands
paulson
parents:
5137
diff
changeset
|
83 |
Goalw [PMap_def,TMap_def] "B<=C ==> PMap(A,B)<=PMap(A,C)"; |
2469 | 84 |
by (Fast_tac 1); |
915 | 85 |
qed "map_mono"; |
86 |
||
87 |
(* Rename to pmap_mono *) |
|
88 |
||
89 |
(* ############################################################ *) |
|
90 |
(* Introduction Rules *) |
|
91 |
(* ############################################################ *) |
|
92 |
||
93 |
(** map_emp **) |
|
94 |
||
5068 | 95 |
Goalw [map_emp_def,PMap_def,TMap_def] "map_emp:PMap(A,B)"; |
5265
9d1d4c43c76d
Disjointness reasoning by AddEs [equals0E, sym RS equals0E]
paulson
parents:
5147
diff
changeset
|
96 |
by Auto_tac; |
915 | 97 |
qed "pmap_empI"; |
98 |
||
99 |
(** map_owr **) |
|
100 |
||
1020
76d72126a9e7
Modified proofs for new hyp_subst_tac, and simplified them.
lcp
parents:
915
diff
changeset
|
101 |
|
5068 | 102 |
Goalw [map_owr_def,PMap_def,TMap_def] |
5147
825877190618
More tidying and removal of "\!\!... from Goal commands
paulson
parents:
5143
diff
changeset
|
103 |
"[| m:PMap(A,B); a:A; b:B |] ==> map_owr(m,a,b):PMap(A,B)"; |
3735 | 104 |
by Safe_tac; |
4091 | 105 |
by (ALLGOALS (asm_full_simp_tac (simpset() addsimps [if_iff]))); |
2469 | 106 |
by (Fast_tac 1); |
107 |
by (Fast_tac 1); |
|
108 |
by (Deepen_tac 2 1); |
|
109 |
(*Remaining subgoal*) |
|
915 | 110 |
by (rtac (excluded_middle RS disjE) 1); |
111 |
by (etac image_Sigma1 1); |
|
1075
848bf2e18dff
Modified proofs for new claset primitives. The problem is that they enforce
lcp
parents:
1020
diff
changeset
|
112 |
by (dres_inst_tac [("psi", "?uu ~: B")] asm_rl 1); |
5137 | 113 |
by (asm_full_simp_tac (simpset() addsimps [qbeta]) 1); |
4152 | 114 |
by Safe_tac; |
1075
848bf2e18dff
Modified proofs for new claset primitives. The problem is that they enforce
lcp
parents:
1020
diff
changeset
|
115 |
by (dres_inst_tac [("psi", "?uu ~: B")] asm_rl 3); |
2469 | 116 |
by (ALLGOALS Asm_full_simp_tac); |
117 |
by (Fast_tac 1); |
|
915 | 118 |
qed "pmap_owrI"; |
119 |
||
120 |
(** map_app **) |
|
121 |
||
5068 | 122 |
Goalw [TMap_def,map_app_def] |
5147
825877190618
More tidying and removal of "\!\!... from Goal commands
paulson
parents:
5143
diff
changeset
|
123 |
"[| m:TMap(A,B); a:domain(m) |] ==> map_app(m,a) ~=0"; |
915 | 124 |
by (etac domainE 1); |
125 |
by (dtac imageI 1); |
|
2469 | 126 |
by (Fast_tac 1); |
915 | 127 |
by (etac not_emptyI 1); |
128 |
qed "tmap_app_notempty"; |
|
129 |
||
5068 | 130 |
Goalw [TMap_def,map_app_def,domain_def] |
5147
825877190618
More tidying and removal of "\!\!... from Goal commands
paulson
parents:
5143
diff
changeset
|
131 |
"[| m:TMap(A,B); a:domain(m) |] ==> map_app(m,a):B"; |
2493 | 132 |
by (Fast_tac 1); |
915 | 133 |
qed "tmap_appI"; |
134 |
||
5068 | 135 |
Goalw [PMap_def] |
5147
825877190618
More tidying and removal of "\!\!... from Goal commands
paulson
parents:
5143
diff
changeset
|
136 |
"[| m:PMap(A,B); a:domain(m) |] ==> map_app(m,a):B"; |
7499 | 137 |
by (ftac tmap_app_notempty 1); |
915 | 138 |
by (assume_tac 1); |
139 |
by (dtac tmap_appI 1); |
|
140 |
by (assume_tac 1); |
|
2469 | 141 |
by (Fast_tac 1); |
915 | 142 |
qed "pmap_appI"; |
143 |
||
144 |
(** domain **) |
|
145 |
||
5068 | 146 |
Goalw [TMap_def] |
5147
825877190618
More tidying and removal of "\!\!... from Goal commands
paulson
parents:
5143
diff
changeset
|
147 |
"[| m:TMap(A,B); a:domain(m) |] ==> a:A"; |
2493 | 148 |
by (Fast_tac 1); |
915 | 149 |
qed "tmap_domainD"; |
150 |
||
5068 | 151 |
Goalw [PMap_def,TMap_def] |
5147
825877190618
More tidying and removal of "\!\!... from Goal commands
paulson
parents:
5143
diff
changeset
|
152 |
"[| m:PMap(A,B); a:domain(m) |] ==> a:A"; |
2493 | 153 |
by (Fast_tac 1); |
915 | 154 |
qed "pmap_domainD"; |
155 |
||
156 |
(* ############################################################ *) |
|
4841
d275fd349f3d
new thms, really demos of the final coalgebra theorem
paulson
parents:
4152
diff
changeset
|
157 |
(* Equalities *) |
915 | 158 |
(* ############################################################ *) |
159 |
||
160 |
(** Domain **) |
|
161 |
||
162 |
(* Lemmas *) |
|
163 |
||
5068 | 164 |
Goal "domain(UN x:A. B(x)) = (UN x:A. domain(B(x)))"; |
2493 | 165 |
by (Fast_tac 1); |
915 | 166 |
qed "domain_UN"; |
167 |
||
5068 | 168 |
Goal "domain(Sigma(A,B)) = {x:A. EX y. y:B(x)}"; |
4091 | 169 |
by (simp_tac (simpset() addsimps [domain_UN,domain_0,domain_cons]) 1); |
2493 | 170 |
by (Fast_tac 1); |
915 | 171 |
qed "domain_Sigma"; |
172 |
||
173 |
(* Theorems *) |
|
174 |
||
5068 | 175 |
Goalw [map_emp_def] "domain(map_emp) = 0"; |
2493 | 176 |
by (Fast_tac 1); |
915 | 177 |
qed "map_domain_emp"; |
178 |
||
5068 | 179 |
Goalw [map_owr_def] |
5147
825877190618
More tidying and removal of "\!\!... from Goal commands
paulson
parents:
5143
diff
changeset
|
180 |
"b ~= 0 ==> domain(map_owr(f,a,b)) = {a} Un domain(f)"; |
4091 | 181 |
by (simp_tac (simpset() addsimps [domain_Sigma]) 1); |
915 | 182 |
by (rtac equalityI 1); |
2493 | 183 |
by (Fast_tac 1); |
915 | 184 |
by (rtac subsetI 1); |
185 |
by (rtac CollectI 1); |
|
186 |
by (assume_tac 1); |
|
187 |
by (etac UnE' 1); |
|
188 |
by (etac singletonE 1); |
|
2469 | 189 |
by (Asm_simp_tac 1); |
2493 | 190 |
by (Fast_tac 1); |
4091 | 191 |
by (fast_tac (claset() addss (simpset())) 1); |
915 | 192 |
qed "map_domain_owr"; |
193 |
||
194 |
(** Application **) |
|
195 |
||
5068 | 196 |
Goalw [map_app_def,map_owr_def] |
6068 | 197 |
"map_app(map_owr(f,a,b),c) = (if c=a then b else map_app(f,c))"; |
6046 | 198 |
by (asm_simp_tac (simpset() addsimps [qbeta_if]) 1); |
2469 | 199 |
by (Fast_tac 1); |
6046 | 200 |
qed "map_app_owr"; |
201 |
||
202 |
Goal "map_app(map_owr(f,a,b),a) = b"; |
|
203 |
by (asm_simp_tac (simpset() addsimps [map_app_owr]) 1); |
|
915 | 204 |
qed "map_app_owr1"; |
205 |
||
6046 | 206 |
Goal "c ~= a ==> map_app(map_owr(f,a,b),c)= map_app(f,c)"; |
207 |
by (asm_simp_tac (simpset() addsimps [map_app_owr]) 1); |
|
915 | 208 |
qed "map_app_owr2"; |