1 (* Title: ZF/InfDatatype.ML |
1 (* Title: ZF/InfDatatype.ML |
2 ID: $Id$ |
2 ID: $Id$ |
3 Author: Lawrence C Paulson, Cambridge University Computer Laboratory |
3 Author: Lawrence C Paulson, Cambridge University Computer Laboratory |
4 Copyright 1994 University of Cambridge |
4 Copyright 1994 University of Cambridge |
5 |
5 |
6 Infinite-Branching Datatype Definitions |
6 Datatype Definitions involving -> |
|
7 Even infinite-branching! |
7 *) |
8 *) |
|
9 |
|
10 (*** Closure under finite powerset ***) |
|
11 |
|
12 val Fin_Univ_thy = merge_theories (Univ.thy,Finite.thy); |
|
13 |
|
14 goal Fin_Univ_thy |
|
15 "!!i. [| b: Fin(Vfrom(A,i)); Limit(i) |] ==> EX j. b <= Vfrom(A,j) & j<i"; |
|
16 by (eresolve_tac [Fin_induct] 1); |
|
17 by (fast_tac (ZF_cs addSDs [Limit_has_0]) 1); |
|
18 by (safe_tac ZF_cs); |
|
19 by (eresolve_tac [Limit_VfromE] 1); |
|
20 by (assume_tac 1); |
|
21 by (res_inst_tac [("x", "xa Un j")] exI 1); |
|
22 by (best_tac (ZF_cs addIs [subset_refl RS Vfrom_mono RS subsetD, |
|
23 Un_least_lt]) 1); |
|
24 val Fin_Vfrom_lemma = result(); |
|
25 |
|
26 goal Fin_Univ_thy "!!i. Limit(i) ==> Fin(Vfrom(A,i)) <= Vfrom(A,i)"; |
|
27 by (rtac subsetI 1); |
|
28 by (dresolve_tac [Fin_Vfrom_lemma] 1); |
|
29 by (safe_tac ZF_cs); |
|
30 by (resolve_tac [Vfrom RS ssubst] 1); |
|
31 by (fast_tac (ZF_cs addSDs [ltD]) 1); |
|
32 val Fin_VLimit = result(); |
|
33 |
|
34 val Fin_subset_VLimit = |
|
35 [Fin_mono, Fin_VLimit] MRS subset_trans |> standard; |
|
36 |
|
37 goal Fin_Univ_thy |
|
38 "!!i. [| n: nat; Limit(i) |] ==> n -> Vfrom(A,i) <= Vfrom(A,i)"; |
|
39 by (eresolve_tac [nat_fun_subset_Fin RS subset_trans] 1); |
|
40 by (REPEAT (ares_tac [Fin_subset_VLimit, Sigma_subset_VLimit, |
|
41 nat_subset_VLimit, subset_refl] 1)); |
|
42 val nat_fun_VLimit = result(); |
|
43 |
|
44 val nat_fun_subset_VLimit = |
|
45 [Pi_mono, nat_fun_VLimit] MRS subset_trans |> standard; |
|
46 |
|
47 |
|
48 goalw Fin_Univ_thy [univ_def] "Fin(univ(A)) <= univ(A)"; |
|
49 by (rtac (Limit_nat RS Fin_VLimit) 1); |
|
50 val Fin_univ = result(); |
|
51 |
|
52 val Fin_subset_univ = [Fin_mono, Fin_univ] MRS subset_trans |> standard; |
|
53 |
|
54 goalw Fin_Univ_thy [univ_def] "!!i. n: nat ==> n -> univ(A) <= univ(A)"; |
|
55 by (etac (Limit_nat RSN (2,nat_fun_VLimit)) 1); |
|
56 val nat_fun_univ = result(); |
|
57 |
|
58 val nat_fun_subset_univ = [Pi_mono, nat_fun_univ] MRS subset_trans |> standard; |
|
59 |
|
60 goal Fin_Univ_thy |
|
61 "!!f. [| f: n -> B; B <= univ(A); n : nat |] ==> f : univ(A)"; |
|
62 by (REPEAT (ares_tac [nat_fun_subset_univ RS subsetD] 1)); |
|
63 val nat_fun_into_univ = result(); |
|
64 |
|
65 |
|
66 (*** Infinite branching ***) |
8 |
67 |
9 val fun_Limit_VfromE = |
68 val fun_Limit_VfromE = |
10 [apply_funtype, InfCard_csucc RS InfCard_is_Limit] MRS Limit_VfromE |
69 [apply_funtype, InfCard_csucc RS InfCard_is_Limit] MRS Limit_VfromE |
11 |> standard; |
70 |> standard; |
|
71 |
|
72 goal InfDatatype.thy |
|
73 "!!K. [| f: I -> Vfrom(A,csucc(K)); |I| le K; InfCard(K) \ |
|
74 \ |] ==> EX j. f: I -> Vfrom(A,j) & j < csucc(K)"; |
|
75 by (res_inst_tac [("x", "UN x:I. LEAST i. f`x : Vfrom(A,i)")] exI 1); |
|
76 by (resolve_tac [conjI] 1); |
|
77 by (resolve_tac [ballI RSN (2,cardinal_UN_Ord_lt_csucc)] 2); |
|
78 by (eresolve_tac [fun_Limit_VfromE] 3 THEN REPEAT_SOME assume_tac); |
|
79 by (fast_tac (ZF_cs addEs [Least_le RS lt_trans1, ltE]) 2); |
|
80 by (resolve_tac [Pi_type] 1); |
|
81 by (rename_tac "k" 2); |
|
82 by (eresolve_tac [fun_Limit_VfromE] 2 THEN REPEAT_SOME assume_tac); |
|
83 by (subgoal_tac "f`k : Vfrom(A, LEAST i. f`k : Vfrom(A,i))" 1); |
|
84 by (fast_tac (ZF_cs addEs [LeastI, ltE]) 2); |
|
85 by (eresolve_tac [[subset_refl, UN_upper] MRS Vfrom_mono RS subsetD] 1); |
|
86 by (assume_tac 1); |
|
87 val fun_Vcsucc_lemma = result(); |
12 |
88 |
13 goal InfDatatype.thy |
89 goal InfDatatype.thy |
14 "!!K. [| f: K -> Vfrom(A,csucc(K)); InfCard(K) \ |
90 "!!K. [| f: K -> Vfrom(A,csucc(K)); InfCard(K) \ |
15 \ |] ==> EX j. f: K -> Vfrom(A,j) & j < csucc(K)"; |
91 \ |] ==> EX j. f: K -> Vfrom(A,j) & j < csucc(K)"; |
16 by (res_inst_tac [("x", "UN k:K. LEAST i. f`k : Vfrom(A,i)")] exI 1); |
92 by (res_inst_tac [("x", "UN k:K. LEAST i. f`k : Vfrom(A,i)")] exI 1); |
23 by (eresolve_tac [fun_Limit_VfromE] 2 THEN REPEAT_SOME assume_tac); |
99 by (eresolve_tac [fun_Limit_VfromE] 2 THEN REPEAT_SOME assume_tac); |
24 by (subgoal_tac "f`k : Vfrom(A, LEAST i. f`k : Vfrom(A,i))" 1); |
100 by (subgoal_tac "f`k : Vfrom(A, LEAST i. f`k : Vfrom(A,i))" 1); |
25 by (fast_tac (ZF_cs addEs [LeastI, ltE]) 2); |
101 by (fast_tac (ZF_cs addEs [LeastI, ltE]) 2); |
26 by (eresolve_tac [[subset_refl, UN_upper] MRS Vfrom_mono RS subsetD] 1); |
102 by (eresolve_tac [[subset_refl, UN_upper] MRS Vfrom_mono RS subsetD] 1); |
27 by (assume_tac 1); |
103 by (assume_tac 1); |
28 val fun_Vfrom_csucc_lemma = result(); |
104 val fun_Vcsucc_lemma = result(); |
29 |
105 |
30 goal InfDatatype.thy |
106 goal InfDatatype.thy |
31 "!!K. InfCard(K) ==> K -> Vfrom(A,csucc(K)) <= Vfrom(A,csucc(K))"; |
107 "!!K. InfCard(K) ==> K -> Vfrom(A,csucc(K)) <= Vfrom(A,csucc(K))"; |
32 by (safe_tac (ZF_cs addSDs [fun_Vfrom_csucc_lemma])); |
108 by (safe_tac (ZF_cs addSDs [fun_Vcsucc_lemma])); |
33 by (resolve_tac [Vfrom RS ssubst] 1); |
109 by (resolve_tac [Vfrom RS ssubst] 1); |
34 by (eresolve_tac [PiE] 1); |
110 by (eresolve_tac [PiE] 1); |
35 (*This level includes the function, and is below csucc(K)*) |
111 (*This level includes the function, and is below csucc(K)*) |
36 by (res_inst_tac [("a1", "succ(succ(K Un j))")] (UN_I RS UnI2) 1); |
112 by (res_inst_tac [("a1", "succ(succ(K Un j))")] (UN_I RS UnI2) 1); |
37 by (eresolve_tac [subset_trans RS PowI] 2); |
113 by (eresolve_tac [subset_trans RS PowI] 2); |
40 by (eresolve_tac [[subset_refl, Un_upper2] MRS Vfrom_mono RS subsetD] 2); |
116 by (eresolve_tac [[subset_refl, Un_upper2] MRS Vfrom_mono RS subsetD] 2); |
41 by (REPEAT (ares_tac [ltD, InfCard_csucc, InfCard_is_Limit, |
117 by (REPEAT (ares_tac [ltD, InfCard_csucc, InfCard_is_Limit, |
42 Limit_has_succ, Un_least_lt] 1)); |
118 Limit_has_succ, Un_least_lt] 1)); |
43 by (eresolve_tac [InfCard_is_Card RS Card_is_Ord RS lt_csucc] 1); |
119 by (eresolve_tac [InfCard_is_Card RS Card_is_Ord RS lt_csucc] 1); |
44 by (assume_tac 1); |
120 by (assume_tac 1); |
45 val fun_Vfrom_csucc = result(); |
121 val fun_Vcsucc = result(); |
46 |
122 |
47 goal InfDatatype.thy |
123 goal InfDatatype.thy |
48 "!!K. [| f: K -> Vfrom(A, csucc(K)); InfCard(K) \ |
124 "!!K. [| f: K -> Vfrom(A, csucc(K)); InfCard(K) \ |
49 \ |] ==> f: Vfrom(A,csucc(K))"; |
125 \ |] ==> f: Vfrom(A,csucc(K))"; |
50 by (REPEAT (ares_tac [fun_Vfrom_csucc RS subsetD] 1)); |
126 by (REPEAT (ares_tac [fun_Vcsucc RS subsetD] 1)); |
51 val fun_in_Vfrom_csucc = result(); |
127 val fun_in_Vcsucc = result(); |
52 |
128 |
53 val fun_subset_Vfrom_csucc = |
129 val fun_subset_Vcsucc = |
54 [Pi_mono, fun_Vfrom_csucc] MRS subset_trans |> standard; |
130 [Pi_mono, fun_Vcsucc] MRS subset_trans |> standard; |
55 |
131 |
56 goal InfDatatype.thy |
132 goal InfDatatype.thy |
57 "!!f. [| f: K -> B; B <= Vfrom(A,csucc(K)); InfCard(K) \ |
133 "!!f. [| f: K -> B; B <= Vfrom(A,csucc(K)); InfCard(K) \ |
58 \ |] ==> f: Vfrom(A,csucc(K))"; |
134 \ |] ==> f: Vfrom(A,csucc(K))"; |
59 by (REPEAT (ares_tac [fun_subset_Vfrom_csucc RS subsetD] 1)); |
135 by (REPEAT (ares_tac [fun_subset_Vcsucc RS subsetD] 1)); |
60 val fun_into_Vfrom_csucc = result(); |
136 val fun_into_Vcsucc = result(); |
61 |
137 |
62 val Limit_csucc = InfCard_csucc RS InfCard_is_Limit |> standard; |
138 val Limit_csucc = InfCard_csucc RS InfCard_is_Limit |> standard; |
63 |
139 |
64 val Pair_in_Vfrom_csucc = Limit_csucc RSN (3, Pair_in_Vfrom_Limit) |> standard; |
140 val Pair_in_Vcsucc = Limit_csucc RSN (3, Pair_in_VLimit) |> standard; |
65 val Inl_in_Vfrom_csucc = Limit_csucc RSN (2, Inl_in_Vfrom_Limit) |> standard; |
141 val Inl_in_Vcsucc = Limit_csucc RSN (2, Inl_in_VLimit) |> standard; |
66 val Inr_in_Vfrom_csucc = Limit_csucc RSN (2, Inr_in_Vfrom_Limit) |> standard; |
142 val Inr_in_Vcsucc = Limit_csucc RSN (2, Inr_in_VLimit) |> standard; |
67 val zero_in_Vfrom_csucc = Limit_csucc RS zero_in_Vfrom_Limit |> standard; |
143 val zero_in_Vcsucc = Limit_csucc RS zero_in_VLimit |> standard; |
68 val nat_into_Vfrom_csucc = Limit_csucc RSN (2, nat_into_Vfrom_Limit) |
144 val nat_into_Vcsucc = Limit_csucc RSN (2, nat_into_VLimit) |> standard; |
69 |> standard; |
|
70 |
145 |
71 (*For most K-branching datatypes with domain Vfrom(A, csucc(K)) *) |
146 (*For most K-branching datatypes with domain Vfrom(A, csucc(K)) *) |
72 val inf_datatype_intrs = |
147 val inf_datatype_intrs = |
73 [fun_in_Vfrom_csucc, InfCard_nat, Pair_in_Vfrom_csucc, |
148 [fun_in_Vcsucc, InfCard_nat, Pair_in_Vcsucc, |
74 Inl_in_Vfrom_csucc, Inr_in_Vfrom_csucc, |
149 Inl_in_Vcsucc, Inr_in_Vcsucc, |
75 zero_in_Vfrom_csucc, A_into_Vfrom, nat_into_Vfrom_csucc] @ datatype_intrs; |
150 zero_in_Vcsucc, A_into_Vfrom, nat_into_Vcsucc] @ datatype_intrs; |
76 |
151 |