blanchet@48975
|
1 |
(* Title: HOL/Codatatype/Tools/bnf_gfp_tactics.ML
|
blanchet@48975
|
2 |
Author: Dmitriy Traytel, TU Muenchen
|
blanchet@48975
|
3 |
Author: Andrei Popescu, TU Muenchen
|
blanchet@48975
|
4 |
Author: Jasmin Blanchette, TU Muenchen
|
blanchet@48975
|
5 |
Copyright 2012
|
blanchet@48975
|
6 |
|
blanchet@48975
|
7 |
Tactics for the codatatype construction.
|
blanchet@48975
|
8 |
*)
|
blanchet@48975
|
9 |
|
blanchet@48975
|
10 |
signature BNF_GFP_TACTICS =
|
blanchet@48975
|
11 |
sig
|
blanchet@48975
|
12 |
val mk_Lev_sbd_tac: cterm option list -> thm list -> thm list -> thm list list -> tactic
|
blanchet@48975
|
13 |
val mk_bd_card_order_tac: thm -> tactic
|
blanchet@48975
|
14 |
val mk_bd_cinfinite_tac: thm -> tactic
|
blanchet@48975
|
15 |
val mk_bis_Gr_tac: thm -> thm list -> thm list -> thm list -> thm list ->
|
blanchet@48975
|
16 |
{prems: 'a, context: Proof.context} -> tactic
|
blanchet@48975
|
17 |
val mk_bis_O_tac: int -> thm -> thm list -> thm list -> tactic
|
blanchet@48975
|
18 |
val mk_bis_Union_tac: thm -> thm list -> {prems: 'a, context: Proof.context} -> tactic
|
blanchet@48975
|
19 |
val mk_bis_converse_tac: int -> thm -> thm list -> thm list -> tactic
|
blanchet@49506
|
20 |
val mk_bis_srel_tac: int -> thm -> thm list -> thm list -> thm list -> thm list list -> tactic
|
blanchet@48975
|
21 |
val mk_carT_set_tac: int -> int -> thm -> thm -> thm -> thm ->
|
blanchet@48975
|
22 |
{prems: 'a, context: Proof.context} -> tactic
|
blanchet@48975
|
23 |
val mk_card_of_carT_tac: int -> thm list -> thm -> thm -> thm -> thm -> thm -> thm list -> tactic
|
blanchet@48975
|
24 |
val mk_coalgT_tac: int -> thm list -> thm list -> thm list list ->
|
blanchet@48975
|
25 |
{prems: 'a, context: Proof.context} -> tactic
|
blanchet@48975
|
26 |
val mk_coalg_final_tac: int -> thm -> thm list -> thm list -> thm list list -> thm list list ->
|
blanchet@48975
|
27 |
tactic
|
blanchet@48975
|
28 |
val mk_coalg_set_tac: thm -> tactic
|
blanchet@48975
|
29 |
val mk_coalg_thePull_tac: int -> thm -> thm list -> thm list list -> (int -> tactic) list ->
|
blanchet@48975
|
30 |
{prems: 'a, context: Proof.context} -> tactic
|
traytel@49104
|
31 |
val mk_coind_wit_tac: thm -> thm list -> thm list -> thm list ->
|
traytel@49104
|
32 |
{prems: 'a, context: Proof.context} -> tactic
|
blanchet@48975
|
33 |
val mk_col_bd_tac: int -> int -> cterm option list -> thm list -> thm list -> thm -> thm ->
|
blanchet@48975
|
34 |
thm list list -> tactic
|
blanchet@48975
|
35 |
val mk_col_natural_tac: cterm option list -> thm list -> thm list -> thm list -> thm list list ->
|
blanchet@48975
|
36 |
{prems: 'a, context: Proof.context} -> tactic
|
blanchet@48975
|
37 |
val mk_congruent_str_final_tac: int -> thm -> thm -> thm -> thm list -> tactic
|
blanchet@48975
|
38 |
val mk_corec_tac: int -> thm list -> thm -> thm -> thm list ->
|
blanchet@48975
|
39 |
{prems: 'a, context: Proof.context} -> tactic
|
blanchet@49501
|
40 |
val mk_dtor_coinduct_tac: int -> int list -> thm -> thm -> tactic
|
blanchet@49506
|
41 |
val mk_dtor_strong_coinduct_tac: int list -> ctyp option list -> cterm option list -> thm ->
|
blanchet@49506
|
42 |
thm -> thm -> tactic
|
blanchet@49501
|
43 |
val mk_dtor_o_ctor_tac: thm -> thm -> thm -> thm -> thm list ->
|
blanchet@49501
|
44 |
{prems: 'a, context: Proof.context} -> tactic
|
blanchet@48975
|
45 |
val mk_equiv_lsbis_tac: thm -> thm -> thm -> thm -> thm -> thm -> tactic
|
blanchet@48975
|
46 |
val mk_hset_minimal_tac: int -> thm list -> thm -> {prems: 'a, context: Proof.context} -> tactic
|
blanchet@48975
|
47 |
val mk_hset_rec_minimal_tac: int -> cterm option list -> thm list -> thm list ->
|
blanchet@48975
|
48 |
{prems: 'a, context: Proof.context} -> tactic
|
blanchet@48975
|
49 |
val mk_in_bd_tac: thm -> thm list -> thm -> thm -> thm -> thm -> thm list -> thm -> thm -> thm ->
|
blanchet@48975
|
50 |
thm -> thm -> thm -> tactic
|
blanchet@48975
|
51 |
val mk_incl_lsbis_tac: int -> int -> thm -> tactic
|
blanchet@48975
|
52 |
val mk_isNode_hset_tac: int -> thm -> thm list -> {prems: 'a, context: Proof.context} -> tactic
|
blanchet@48975
|
53 |
val mk_length_Lev'_tac: thm -> tactic
|
blanchet@48975
|
54 |
val mk_length_Lev_tac: cterm option list -> thm list -> thm list -> tactic
|
blanchet@48975
|
55 |
val mk_map_comp_tac: int -> int -> thm list -> thm list -> thm list -> thm -> tactic
|
blanchet@48975
|
56 |
val mk_mcong_tac: int -> (int -> tactic) -> thm list -> thm list -> thm list -> thm list list ->
|
blanchet@48975
|
57 |
thm list list -> thm list list list -> tactic
|
blanchet@48975
|
58 |
val mk_map_id_tac: thm list -> thm -> thm -> tactic
|
blanchet@48975
|
59 |
val mk_map_tac: int -> int -> ctyp option -> thm -> thm -> thm -> tactic
|
blanchet@48975
|
60 |
val mk_map_unique_tac: thm -> thm list -> {prems: 'a, context: Proof.context} -> tactic
|
blanchet@48975
|
61 |
val mk_mor_Abs_tac: thm list -> thm list -> {prems: 'a, context: Proof.context} -> tactic
|
blanchet@48975
|
62 |
val mk_mor_Rep_tac: int -> thm list -> thm list -> thm list -> thm list list -> thm list ->
|
blanchet@48975
|
63 |
thm list -> {prems: 'a, context: Proof.context} -> tactic
|
blanchet@48975
|
64 |
val mk_mor_T_final_tac: thm -> thm list -> thm list -> tactic
|
blanchet@48975
|
65 |
val mk_mor_UNIV_tac: thm list -> thm -> tactic
|
blanchet@48975
|
66 |
val mk_mor_beh_tac: int -> thm -> thm -> thm list -> thm list -> thm list -> thm list ->
|
blanchet@48975
|
67 |
thm list list -> thm list list -> thm list -> thm list -> thm list -> thm list -> thm list ->
|
blanchet@48975
|
68 |
thm list -> thm list -> thm list -> thm list list -> thm list list list -> thm list list list ->
|
blanchet@48975
|
69 |
thm list list list -> thm list list -> thm list list -> thm list -> thm list -> thm list ->
|
blanchet@48975
|
70 |
{prems: 'a, context: Proof.context} -> tactic
|
blanchet@48975
|
71 |
val mk_mor_comp_tac: thm -> thm list -> thm list -> thm list -> tactic
|
blanchet@48975
|
72 |
val mk_mor_elim_tac: thm -> tactic
|
blanchet@48975
|
73 |
val mk_mor_hset_rec_tac: int -> int -> cterm option list -> int -> thm list -> thm list ->
|
blanchet@48975
|
74 |
thm list -> thm list list -> thm list list -> tactic
|
blanchet@48975
|
75 |
val mk_mor_hset_tac: thm -> thm -> tactic
|
blanchet@48975
|
76 |
val mk_mor_incl_tac: thm -> thm list -> tactic
|
blanchet@48975
|
77 |
val mk_mor_str_tac: 'a list -> thm -> tactic
|
blanchet@48975
|
78 |
val mk_mor_sum_case_tac: 'a list -> thm -> tactic
|
blanchet@48975
|
79 |
val mk_mor_thePull_fst_tac: int -> thm -> thm list -> thm list -> (int -> tactic) list ->
|
blanchet@48975
|
80 |
{prems: thm list, context: Proof.context} -> tactic
|
blanchet@48975
|
81 |
val mk_mor_thePull_snd_tac: int -> thm -> thm list -> thm list -> (int -> tactic) list ->
|
blanchet@48975
|
82 |
{prems: thm list, context: Proof.context} -> tactic
|
blanchet@48975
|
83 |
val mk_mor_thePull_pick_tac: thm -> thm list -> thm list ->
|
blanchet@48975
|
84 |
{prems: 'a, context: Proof.context} -> tactic
|
blanchet@49504
|
85 |
val mk_mor_unfold_tac: int -> thm -> thm list -> thm list -> thm list -> thm list -> thm list ->
|
blanchet@49504
|
86 |
thm list -> tactic
|
blanchet@48975
|
87 |
val mk_prefCl_Lev_tac: cterm option list -> thm list -> thm list -> tactic
|
blanchet@48975
|
88 |
val mk_pickWP_assms_tac: thm list -> thm list -> thm -> (int -> tactic)
|
blanchet@48975
|
89 |
val mk_pick_col_tac: int -> int -> cterm option list -> thm list -> thm list -> thm list ->
|
blanchet@48975
|
90 |
thm list list -> thm list -> (int -> tactic) list -> {prems: 'a, context: Proof.context} ->
|
blanchet@48975
|
91 |
tactic
|
blanchet@48975
|
92 |
val mk_raw_coind_tac: thm -> thm -> thm -> thm -> thm -> thm -> thm -> thm -> thm -> thm list ->
|
blanchet@48975
|
93 |
thm list -> thm list -> thm -> thm list -> tactic
|
blanchet@48975
|
94 |
val mk_rv_last_tac: ctyp option list -> cterm option list -> thm list -> thm list -> tactic
|
blanchet@48975
|
95 |
val mk_sbis_lsbis_tac: thm list -> thm -> thm -> tactic
|
blanchet@48975
|
96 |
val mk_set_Lev_tac: cterm option list -> thm list -> thm list -> thm list -> thm list ->
|
blanchet@48975
|
97 |
thm list list -> tactic
|
blanchet@48975
|
98 |
val mk_set_bd_tac: thm -> thm -> thm -> tactic
|
blanchet@48975
|
99 |
val mk_set_hset_incl_hset_tac: int -> thm list -> thm -> int -> tactic
|
blanchet@48975
|
100 |
val mk_set_image_Lev_tac: cterm option list -> thm list -> thm list -> thm list -> thm list ->
|
blanchet@48975
|
101 |
thm list list -> thm list list -> tactic
|
blanchet@48975
|
102 |
val mk_set_incl_hin_tac: thm list -> tactic
|
blanchet@48975
|
103 |
val mk_set_incl_hset_tac: thm -> thm -> tactic
|
blanchet@48975
|
104 |
val mk_set_le_tac: int -> thm -> thm list -> thm list list -> tactic
|
blanchet@48975
|
105 |
val mk_set_natural_tac: thm -> thm -> tactic
|
blanchet@48975
|
106 |
val mk_set_rv_Lev_tac: int -> cterm option list -> thm list -> thm list -> thm list -> thm list ->
|
blanchet@48975
|
107 |
thm list list -> thm list list -> tactic
|
blanchet@48975
|
108 |
val mk_set_simp_tac: int -> thm -> thm -> thm list -> tactic
|
blanchet@49506
|
109 |
val mk_srel_coinduct_tac: 'a list -> thm -> thm -> tactic
|
blanchet@49506
|
110 |
val mk_srel_strong_coinduct_tac: int -> ctyp option list -> cterm option list -> thm ->
|
blanchet@49506
|
111 |
thm list -> thm list -> tactic
|
blanchet@49506
|
112 |
val mk_srel_simp_tac: thm list -> int -> thm -> thm -> thm -> thm -> thm list -> thm -> thm ->
|
blanchet@49506
|
113 |
thm list -> thm list -> thm list list -> tactic
|
blanchet@48975
|
114 |
val mk_strT_hset_tac: int -> int -> int -> ctyp option list -> ctyp option list ->
|
blanchet@48975
|
115 |
cterm option list -> thm list -> thm list -> thm list -> thm list -> thm list list ->
|
blanchet@48975
|
116 |
thm list list -> thm list list -> thm -> thm list list -> tactic
|
blanchet@49504
|
117 |
val mk_unfold_unique_mor_tac: thm list -> thm -> thm -> thm list -> tactic
|
blanchet@48975
|
118 |
val mk_unique_mor_tac: thm list -> thm -> tactic
|
traytel@49104
|
119 |
val mk_wit_tac: int -> thm list -> thm list -> thm list -> thm list ->
|
blanchet@48975
|
120 |
{prems: 'a, context: Proof.context} -> tactic
|
blanchet@48975
|
121 |
val mk_wpull_tac: int -> thm -> thm -> thm -> thm -> thm -> thm list -> thm list -> tactic
|
blanchet@48975
|
122 |
end;
|
blanchet@48975
|
123 |
|
blanchet@48975
|
124 |
structure BNF_GFP_Tactics : BNF_GFP_TACTICS =
|
blanchet@48975
|
125 |
struct
|
blanchet@48975
|
126 |
|
blanchet@48975
|
127 |
open BNF_Tactics
|
blanchet@48975
|
128 |
open BNF_Util
|
blanchet@49457
|
129 |
open BNF_FP
|
blanchet@48975
|
130 |
open BNF_GFP_Util
|
blanchet@48975
|
131 |
|
blanchet@49305
|
132 |
val fst_convol_fun_cong_sym = @{thm fst_convol} RS fun_cong RS sym;
|
traytel@49488
|
133 |
val list_inject_iffD1 = @{thm list.inject[THEN iffD1]};
|
blanchet@49305
|
134 |
val nat_induct = @{thm nat_induct};
|
blanchet@49305
|
135 |
val o_apply_trans_sym = o_apply RS trans RS sym;
|
blanchet@49305
|
136 |
val ord_eq_le_trans = @{thm ord_eq_le_trans};
|
blanchet@49305
|
137 |
val ord_eq_le_trans_trans_fun_cong_image_id_id_apply =
|
blanchet@49305
|
138 |
@{thm ord_eq_le_trans[OF trans[OF fun_cong[OF image_id] id_apply]]};
|
blanchet@49305
|
139 |
val ordIso_ordLeq_trans = @{thm ordIso_ordLeq_trans};
|
blanchet@49305
|
140 |
val snd_convol_fun_cong_sym = @{thm snd_convol} RS fun_cong RS sym;
|
blanchet@49328
|
141 |
val sum_case_weak_cong = @{thm sum_case_weak_cong};
|
blanchet@49305
|
142 |
val trans_fun_cong_image_id_id_apply = @{thm trans[OF fun_cong[OF image_id] id_apply]};
|
blanchet@49305
|
143 |
|
blanchet@48975
|
144 |
fun mk_coalg_set_tac coalg_def =
|
traytel@49488
|
145 |
dtac (coalg_def RS iffD1) 1 THEN
|
blanchet@48975
|
146 |
REPEAT_DETERM (etac conjE 1) THEN
|
blanchet@48975
|
147 |
EVERY' [dtac @{thm rev_bspec}, atac] 1 THEN
|
blanchet@48975
|
148 |
REPEAT_DETERM (eresolve_tac [CollectE, conjE] 1) THEN atac 1;
|
blanchet@48975
|
149 |
|
blanchet@48975
|
150 |
fun mk_mor_elim_tac mor_def =
|
blanchet@48975
|
151 |
(dtac (subst OF [mor_def]) THEN'
|
blanchet@48975
|
152 |
REPEAT o etac conjE THEN'
|
blanchet@48975
|
153 |
TRY o rtac @{thm image_subsetI} THEN'
|
blanchet@48975
|
154 |
etac bspec THEN'
|
blanchet@48975
|
155 |
atac) 1;
|
blanchet@48975
|
156 |
|
blanchet@48975
|
157 |
fun mk_mor_incl_tac mor_def map_id's =
|
blanchet@48975
|
158 |
(stac mor_def THEN'
|
blanchet@48975
|
159 |
rtac conjI THEN'
|
blanchet@49305
|
160 |
CONJ_WRAP' (K (EVERY' [rtac ballI, etac set_mp, stac @{thm id_apply}, atac]))
|
blanchet@48975
|
161 |
map_id's THEN'
|
blanchet@48975
|
162 |
CONJ_WRAP' (fn thm =>
|
blanchet@48975
|
163 |
(EVERY' [rtac ballI, rtac (thm RS trans), rtac sym, rtac (@{thm id_apply} RS arg_cong)]))
|
blanchet@48975
|
164 |
map_id's) 1;
|
blanchet@48975
|
165 |
|
blanchet@48975
|
166 |
fun mk_mor_comp_tac mor_def mor_images morEs map_comp_ids =
|
blanchet@48975
|
167 |
let
|
blanchet@48975
|
168 |
fun fbetw_tac image = EVERY' [rtac ballI, stac o_apply, etac image, etac image, atac];
|
blanchet@48975
|
169 |
fun mor_tac ((mor_image, morE), map_comp_id) =
|
blanchet@48975
|
170 |
EVERY' [rtac ballI, stac o_apply, rtac trans, rtac (map_comp_id RS sym), rtac trans,
|
blanchet@48975
|
171 |
etac (morE RS arg_cong), atac, etac morE, etac mor_image, atac];
|
blanchet@48975
|
172 |
in
|
blanchet@48975
|
173 |
(stac mor_def THEN' rtac conjI THEN'
|
blanchet@48975
|
174 |
CONJ_WRAP' fbetw_tac mor_images THEN'
|
blanchet@48975
|
175 |
CONJ_WRAP' mor_tac ((mor_images ~~ morEs) ~~ map_comp_ids)) 1
|
blanchet@48975
|
176 |
end;
|
blanchet@48975
|
177 |
|
blanchet@48975
|
178 |
fun mk_mor_UNIV_tac morEs mor_def =
|
blanchet@48975
|
179 |
let
|
blanchet@48975
|
180 |
val n = length morEs;
|
blanchet@48975
|
181 |
fun mor_tac morE = EVERY' [rtac ext, rtac trans, rtac o_apply, rtac trans, etac morE,
|
blanchet@48975
|
182 |
rtac UNIV_I, rtac sym, rtac o_apply];
|
blanchet@48975
|
183 |
in
|
blanchet@48975
|
184 |
EVERY' [rtac iffI, CONJ_WRAP' mor_tac morEs,
|
blanchet@48975
|
185 |
stac mor_def, rtac conjI, CONJ_WRAP' (K (rtac ballI THEN' rtac UNIV_I)) morEs,
|
blanchet@48975
|
186 |
CONJ_WRAP' (fn i =>
|
blanchet@48975
|
187 |
EVERY' [dtac (mk_conjunctN n i), rtac ballI, etac @{thm pointfreeE}]) (1 upto n)] 1
|
blanchet@48975
|
188 |
end;
|
blanchet@48975
|
189 |
|
blanchet@48975
|
190 |
fun mk_mor_str_tac ks mor_UNIV =
|
blanchet@48975
|
191 |
(stac mor_UNIV THEN' CONJ_WRAP' (K (rtac refl)) ks) 1;
|
blanchet@48975
|
192 |
|
blanchet@48975
|
193 |
fun mk_mor_sum_case_tac ks mor_UNIV =
|
blanchet@48975
|
194 |
(stac mor_UNIV THEN' CONJ_WRAP' (K (rtac @{thm sum_case_comp_Inl[symmetric]})) ks) 1;
|
blanchet@48975
|
195 |
|
blanchet@48975
|
196 |
fun mk_set_incl_hset_tac def rec_Suc =
|
blanchet@48975
|
197 |
EVERY' (stac def ::
|
blanchet@48975
|
198 |
map rtac [@{thm incl_UNION_I}, UNIV_I, @{thm ord_le_eq_trans}, @{thm Un_upper1},
|
blanchet@48975
|
199 |
sym, rec_Suc]) 1;
|
blanchet@48975
|
200 |
|
blanchet@48975
|
201 |
fun mk_set_hset_incl_hset_tac n defs rec_Suc i =
|
blanchet@48975
|
202 |
EVERY' (map (TRY oo stac) defs @
|
blanchet@49305
|
203 |
map rtac [@{thm UN_least}, subsetI, @{thm UN_I}, UNIV_I, set_mp, equalityD2, rec_Suc, UnI2,
|
blanchet@49366
|
204 |
mk_UnIN n i] @
|
blanchet@48975
|
205 |
[etac @{thm UN_I}, atac]) 1;
|
blanchet@48975
|
206 |
|
blanchet@48975
|
207 |
fun mk_set_incl_hin_tac incls =
|
traytel@49490
|
208 |
if null incls then rtac subset_UNIV 1
|
blanchet@48975
|
209 |
else EVERY' [rtac subsetI, rtac CollectI,
|
blanchet@48975
|
210 |
CONJ_WRAP' (fn incl => EVERY' [rtac subset_trans, etac incl, atac]) incls] 1;
|
blanchet@48975
|
211 |
|
blanchet@48975
|
212 |
fun mk_hset_rec_minimal_tac m cts rec_0s rec_Sucs {context = ctxt, prems = _} =
|
blanchet@49305
|
213 |
EVERY' [rtac (Drule.instantiate' [] cts nat_induct),
|
blanchet@48975
|
214 |
REPEAT_DETERM o rtac allI,
|
blanchet@48975
|
215 |
CONJ_WRAP' (fn thm => EVERY'
|
blanchet@49305
|
216 |
[rtac ord_eq_le_trans, rtac thm, rtac @{thm empty_subsetI}]) rec_0s,
|
blanchet@48975
|
217 |
REPEAT_DETERM o rtac allI,
|
blanchet@48975
|
218 |
CONJ_WRAP' (fn rec_Suc => EVERY'
|
blanchet@49305
|
219 |
[rtac ord_eq_le_trans, rtac rec_Suc,
|
blanchet@48975
|
220 |
if m = 0 then K all_tac
|
blanchet@48975
|
221 |
else (rtac @{thm Un_least} THEN' Goal.assume_rule_tac ctxt),
|
blanchet@48975
|
222 |
CONJ_WRAP_GEN' (rtac (Thm.permute_prems 0 1 @{thm Un_least}))
|
blanchet@48975
|
223 |
(K (EVERY' [rtac @{thm UN_least}, REPEAT_DETERM o eresolve_tac [allE, conjE],
|
blanchet@48975
|
224 |
rtac subset_trans, atac, Goal.assume_rule_tac ctxt])) rec_0s])
|
blanchet@48975
|
225 |
rec_Sucs] 1;
|
blanchet@48975
|
226 |
|
blanchet@48975
|
227 |
fun mk_hset_minimal_tac n hset_defs hset_rec_minimal {context = ctxt, prems = _} =
|
blanchet@49305
|
228 |
(CONJ_WRAP' (fn def => (EVERY' [rtac ord_eq_le_trans, rtac def,
|
blanchet@48975
|
229 |
rtac @{thm UN_least}, rtac rev_mp, rtac hset_rec_minimal,
|
blanchet@48975
|
230 |
EVERY' (replicate ((n + 1) * n) (Goal.assume_rule_tac ctxt)), rtac impI,
|
blanchet@48975
|
231 |
REPEAT_DETERM o eresolve_tac [allE, conjE], atac])) hset_defs) 1
|
blanchet@48975
|
232 |
|
blanchet@48975
|
233 |
fun mk_mor_hset_rec_tac m n cts j rec_0s rec_Sucs morEs set_naturalss coalg_setss =
|
blanchet@49305
|
234 |
EVERY' [rtac (Drule.instantiate' [] cts nat_induct),
|
blanchet@48975
|
235 |
REPEAT_DETERM o rtac allI,
|
blanchet@48975
|
236 |
CONJ_WRAP' (fn thm => EVERY' (map rtac [impI, thm RS trans, thm RS sym])) rec_0s,
|
blanchet@48975
|
237 |
REPEAT_DETERM o rtac allI,
|
blanchet@48975
|
238 |
CONJ_WRAP'
|
blanchet@48975
|
239 |
(fn (rec_Suc, (morE, ((passive_set_naturals, active_set_naturals), coalg_sets))) =>
|
blanchet@48975
|
240 |
EVERY' [rtac impI, rtac (rec_Suc RS trans), rtac (rec_Suc RS trans RS sym),
|
blanchet@48975
|
241 |
if m = 0 then K all_tac
|
blanchet@48975
|
242 |
else EVERY' [rtac @{thm Un_cong}, rtac box_equals,
|
blanchet@48975
|
243 |
rtac (nth passive_set_naturals (j - 1) RS sym),
|
blanchet@49305
|
244 |
rtac trans_fun_cong_image_id_id_apply, etac (morE RS arg_cong), atac],
|
blanchet@48975
|
245 |
CONJ_WRAP_GEN' (rtac (Thm.permute_prems 0 1 @{thm Un_cong}))
|
blanchet@48975
|
246 |
(fn (i, (set_natural, coalg_set)) =>
|
blanchet@48975
|
247 |
EVERY' [rtac sym, rtac trans, rtac (refl RSN (2, @{thm UN_cong})),
|
blanchet@48975
|
248 |
etac (morE RS sym RS arg_cong RS trans), atac, rtac set_natural,
|
blanchet@48975
|
249 |
rtac (@{thm UN_simps(10)} RS trans), rtac (refl RS @{thm UN_cong}),
|
blanchet@49305
|
250 |
ftac coalg_set, atac, dtac set_mp, atac, rtac mp, rtac (mk_conjunctN n i),
|
blanchet@48975
|
251 |
REPEAT_DETERM o etac allE, atac, atac])
|
blanchet@48975
|
252 |
(rev ((1 upto n) ~~ (active_set_naturals ~~ coalg_sets)))])
|
blanchet@48975
|
253 |
(rec_Sucs ~~ (morEs ~~ (map (chop m) set_naturalss ~~ map (drop m) coalg_setss)))] 1;
|
blanchet@48975
|
254 |
|
blanchet@48975
|
255 |
fun mk_mor_hset_tac hset_def mor_hset_rec =
|
blanchet@48975
|
256 |
EVERY' [rtac (hset_def RS trans), rtac (refl RS @{thm UN_cong} RS trans), etac mor_hset_rec,
|
blanchet@48975
|
257 |
atac, atac, rtac (hset_def RS sym)] 1
|
blanchet@48975
|
258 |
|
blanchet@49506
|
259 |
fun mk_bis_srel_tac m bis_def srel_O_Grs map_comps map_congs set_naturalss =
|
blanchet@48975
|
260 |
let
|
blanchet@49506
|
261 |
val n = length srel_O_Grs;
|
blanchet@49506
|
262 |
val thms = ((1 upto n) ~~ map_comps ~~ map_congs ~~ set_naturalss ~~ srel_O_Grs);
|
blanchet@48975
|
263 |
|
blanchet@49506
|
264 |
fun mk_if_tac ((((i, map_comp), map_cong), set_naturals), srel_O_Gr) =
|
blanchet@48975
|
265 |
EVERY' [rtac allI, rtac allI, rtac impI, dtac (mk_conjunctN n i),
|
blanchet@48975
|
266 |
etac allE, etac allE, etac impE, atac, etac bexE, etac conjE,
|
blanchet@49506
|
267 |
rtac (srel_O_Gr RS equalityD2 RS set_mp),
|
blanchet@48975
|
268 |
rtac @{thm relcompI}, rtac @{thm converseI},
|
blanchet@48975
|
269 |
EVERY' (map (fn thm =>
|
blanchet@48975
|
270 |
EVERY' [rtac @{thm GrI}, REPEAT_DETERM o eresolve_tac [CollectE, conjE],
|
blanchet@48975
|
271 |
rtac CollectI,
|
blanchet@48975
|
272 |
CONJ_WRAP' (fn (i, thm) =>
|
blanchet@48975
|
273 |
if i <= m
|
blanchet@49305
|
274 |
then EVERY' [rtac ord_eq_le_trans, rtac thm, rtac subset_trans,
|
blanchet@48975
|
275 |
etac @{thm image_mono}, rtac @{thm image_subsetI}, etac @{thm diagI}]
|
blanchet@49305
|
276 |
else EVERY' [rtac ord_eq_le_trans, rtac trans, rtac thm,
|
blanchet@49305
|
277 |
rtac trans_fun_cong_image_id_id_apply, atac])
|
blanchet@48975
|
278 |
(1 upto (m + n) ~~ set_naturals),
|
blanchet@48975
|
279 |
rtac trans, rtac trans, rtac map_comp, rtac map_cong, REPEAT_DETERM_N m o rtac thm,
|
blanchet@48975
|
280 |
REPEAT_DETERM_N n o rtac (@{thm o_id} RS fun_cong), atac])
|
blanchet@48975
|
281 |
@{thms fst_diag_id snd_diag_id})];
|
blanchet@48975
|
282 |
|
blanchet@49506
|
283 |
fun mk_only_if_tac ((((i, map_comp), map_cong), set_naturals), srel_O_Gr) =
|
blanchet@48975
|
284 |
EVERY' [dtac (mk_conjunctN n i), rtac allI, rtac allI, rtac impI,
|
blanchet@48975
|
285 |
etac allE, etac allE, etac impE, atac,
|
blanchet@49506
|
286 |
dtac (srel_O_Gr RS equalityD1 RS set_mp),
|
blanchet@48975
|
287 |
REPEAT_DETERM o eresolve_tac [CollectE, @{thm relcompE}, @{thm converseE}],
|
blanchet@48975
|
288 |
REPEAT_DETERM o eresolve_tac [@{thm GrE}, exE, conjE],
|
traytel@49488
|
289 |
REPEAT_DETERM o dtac Pair_eqD,
|
blanchet@48975
|
290 |
REPEAT_DETERM o etac conjE,
|
blanchet@48975
|
291 |
hyp_subst_tac,
|
blanchet@48975
|
292 |
REPEAT_DETERM o eresolve_tac [CollectE, conjE],
|
blanchet@48975
|
293 |
rtac bexI, rtac conjI, rtac trans, rtac map_comp,
|
blanchet@48975
|
294 |
REPEAT_DETERM_N m o stac @{thm id_o},
|
blanchet@48975
|
295 |
REPEAT_DETERM_N n o stac @{thm o_id},
|
blanchet@48975
|
296 |
etac sym, rtac trans, rtac map_comp,
|
blanchet@48975
|
297 |
REPEAT_DETERM_N m o stac @{thm id_o},
|
blanchet@48975
|
298 |
REPEAT_DETERM_N n o stac @{thm o_id},
|
blanchet@48975
|
299 |
rtac trans, rtac map_cong,
|
blanchet@49305
|
300 |
REPEAT_DETERM_N m o EVERY' [rtac @{thm diagE'}, etac set_mp, atac],
|
blanchet@48975
|
301 |
REPEAT_DETERM_N n o rtac refl,
|
blanchet@48975
|
302 |
etac sym, rtac CollectI,
|
blanchet@48975
|
303 |
CONJ_WRAP' (fn (i, thm) =>
|
blanchet@48975
|
304 |
if i <= m
|
blanchet@49305
|
305 |
then EVERY' [rtac ord_eq_le_trans, rtac thm, rtac @{thm image_subsetI},
|
blanchet@49305
|
306 |
rtac @{thm diag_fst}, etac set_mp, atac]
|
blanchet@49305
|
307 |
else EVERY' [rtac ord_eq_le_trans, rtac trans, rtac thm,
|
blanchet@49305
|
308 |
rtac trans_fun_cong_image_id_id_apply, atac])
|
blanchet@48975
|
309 |
(1 upto (m + n) ~~ set_naturals)];
|
blanchet@48975
|
310 |
in
|
blanchet@48975
|
311 |
EVERY' [rtac (bis_def RS trans),
|
blanchet@48975
|
312 |
rtac iffI, etac conjE, etac conjI, CONJ_WRAP' mk_if_tac thms,
|
blanchet@48975
|
313 |
etac conjE, etac conjI, CONJ_WRAP' mk_only_if_tac thms] 1
|
blanchet@48975
|
314 |
end;
|
blanchet@48975
|
315 |
|
blanchet@49506
|
316 |
fun mk_bis_converse_tac m bis_srel srel_congs srel_converses =
|
blanchet@49506
|
317 |
EVERY' [stac bis_srel, dtac (bis_srel RS iffD1),
|
blanchet@48975
|
318 |
REPEAT_DETERM o etac conjE, rtac conjI,
|
blanchet@48975
|
319 |
CONJ_WRAP' (K (EVERY' [rtac @{thm converse_shift}, etac subset_trans,
|
blanchet@49506
|
320 |
rtac equalityD2, rtac @{thm converse_Times}])) srel_congs,
|
blanchet@49506
|
321 |
CONJ_WRAP' (fn (srel_cong, srel_converse) =>
|
blanchet@48975
|
322 |
EVERY' [rtac allI, rtac allI, rtac impI, rtac @{thm set_mp[OF equalityD2]},
|
blanchet@49506
|
323 |
rtac (srel_cong RS trans),
|
blanchet@48975
|
324 |
REPEAT_DETERM_N m o rtac @{thm diag_converse},
|
blanchet@49506
|
325 |
REPEAT_DETERM_N (length srel_congs) o rtac refl,
|
blanchet@49506
|
326 |
rtac srel_converse,
|
blanchet@48975
|
327 |
REPEAT_DETERM o etac allE,
|
blanchet@49506
|
328 |
rtac @{thm converseI}, etac mp, etac @{thm converseD}]) (srel_congs ~~ srel_converses)] 1;
|
blanchet@48975
|
329 |
|
blanchet@49506
|
330 |
fun mk_bis_O_tac m bis_srel srel_congs srel_Os =
|
blanchet@49506
|
331 |
EVERY' [stac bis_srel, REPEAT_DETERM o dtac (bis_srel RS iffD1),
|
blanchet@48975
|
332 |
REPEAT_DETERM o etac conjE, rtac conjI,
|
blanchet@49506
|
333 |
CONJ_WRAP' (K (EVERY' [etac @{thm relcomp_subset_Sigma}, atac])) srel_congs,
|
blanchet@49506
|
334 |
CONJ_WRAP' (fn (srel_cong, srel_O) =>
|
blanchet@48975
|
335 |
EVERY' [rtac allI, rtac allI, rtac impI, rtac @{thm set_mp[OF equalityD2]},
|
blanchet@49506
|
336 |
rtac (srel_cong RS trans),
|
blanchet@48975
|
337 |
REPEAT_DETERM_N m o rtac @{thm diag_Comp},
|
blanchet@49506
|
338 |
REPEAT_DETERM_N (length srel_congs) o rtac refl,
|
blanchet@49506
|
339 |
rtac srel_O,
|
blanchet@48975
|
340 |
etac @{thm relcompE},
|
traytel@49488
|
341 |
REPEAT_DETERM o dtac Pair_eqD,
|
blanchet@48975
|
342 |
etac conjE, hyp_subst_tac,
|
blanchet@48975
|
343 |
REPEAT_DETERM o etac allE, rtac @{thm relcompI},
|
blanchet@49506
|
344 |
etac mp, atac, etac mp, atac]) (srel_congs ~~ srel_Os)] 1;
|
blanchet@48975
|
345 |
|
blanchet@49506
|
346 |
fun mk_bis_Gr_tac bis_srel srel_Grs mor_images morEs coalg_ins
|
blanchet@48975
|
347 |
{context = ctxt, prems = _} =
|
blanchet@49506
|
348 |
unfold_thms_tac ctxt (bis_srel :: @{thm diag_Gr} :: srel_Grs) THEN
|
blanchet@48975
|
349 |
EVERY' [rtac conjI,
|
blanchet@48975
|
350 |
CONJ_WRAP' (fn thm => rtac (@{thm Gr_incl} RS ssubst) THEN' etac thm) mor_images,
|
blanchet@48975
|
351 |
CONJ_WRAP' (fn (coalg_in, morE) =>
|
blanchet@48975
|
352 |
EVERY' [rtac allI, rtac allI, rtac impI, rtac @{thm GrI}, etac coalg_in,
|
blanchet@48975
|
353 |
etac @{thm GrD1}, etac (morE RS trans), etac @{thm GrD1},
|
blanchet@48975
|
354 |
etac (@{thm GrD2} RS arg_cong)]) (coalg_ins ~~ morEs)] 1;
|
blanchet@48975
|
355 |
|
blanchet@48975
|
356 |
fun mk_bis_Union_tac bis_def in_monos {context = ctxt, prems = _} =
|
blanchet@48975
|
357 |
let
|
blanchet@48975
|
358 |
val n = length in_monos;
|
blanchet@48975
|
359 |
val ks = 1 upto n;
|
blanchet@48975
|
360 |
in
|
blanchet@49504
|
361 |
unfold_thms_tac ctxt [bis_def] THEN
|
blanchet@48975
|
362 |
EVERY' [rtac conjI,
|
blanchet@48975
|
363 |
CONJ_WRAP' (fn i =>
|
blanchet@48975
|
364 |
EVERY' [rtac @{thm UN_least}, dtac bspec, atac,
|
blanchet@48975
|
365 |
dtac conjunct1, etac (mk_conjunctN n i)]) ks,
|
blanchet@48975
|
366 |
CONJ_WRAP' (fn (i, in_mono) =>
|
blanchet@48975
|
367 |
EVERY' [rtac allI, rtac allI, rtac impI, etac @{thm UN_E}, dtac bspec, atac,
|
blanchet@48975
|
368 |
dtac conjunct2, dtac (mk_conjunctN n i), etac allE, etac allE, dtac mp,
|
blanchet@48975
|
369 |
atac, etac bexE, rtac bexI, atac, rtac in_mono,
|
blanchet@48975
|
370 |
REPEAT_DETERM_N n o etac @{thm incl_UNION_I[OF _ subset_refl]},
|
blanchet@48975
|
371 |
atac]) (ks ~~ in_monos)] 1
|
blanchet@48975
|
372 |
end;
|
blanchet@48975
|
373 |
|
blanchet@48975
|
374 |
fun mk_sbis_lsbis_tac lsbis_defs bis_Union bis_cong =
|
blanchet@48975
|
375 |
let
|
blanchet@48975
|
376 |
val n = length lsbis_defs;
|
blanchet@48975
|
377 |
in
|
blanchet@48975
|
378 |
EVERY' [rtac (Thm.permute_prems 0 1 bis_cong), EVERY' (map rtac lsbis_defs),
|
blanchet@48975
|
379 |
rtac bis_Union, rtac ballI, REPEAT_DETERM o eresolve_tac [CollectE, conjE, exE],
|
blanchet@48975
|
380 |
hyp_subst_tac, etac bis_cong, EVERY' (map (rtac o mk_nth_conv n) (1 upto n))] 1
|
blanchet@48975
|
381 |
end;
|
blanchet@48975
|
382 |
|
blanchet@48975
|
383 |
fun mk_incl_lsbis_tac n i lsbis_def =
|
blanchet@48975
|
384 |
EVERY' [rtac @{thm xt1(3)}, rtac lsbis_def, rtac @{thm incl_UNION_I}, rtac CollectI,
|
blanchet@48975
|
385 |
REPEAT_DETERM_N n o rtac exI, rtac conjI, rtac refl, atac, rtac equalityD2,
|
blanchet@48975
|
386 |
rtac (mk_nth_conv n i)] 1;
|
blanchet@48975
|
387 |
|
blanchet@48975
|
388 |
fun mk_equiv_lsbis_tac sbis_lsbis lsbis_incl incl_lsbis bis_diag bis_converse bis_O =
|
traytel@49488
|
389 |
EVERY' [rtac (@{thm equiv_def} RS iffD2),
|
blanchet@48975
|
390 |
|
traytel@49488
|
391 |
rtac conjI, rtac (@{thm refl_on_def} RS iffD2),
|
blanchet@49305
|
392 |
rtac conjI, rtac lsbis_incl, rtac ballI, rtac set_mp,
|
blanchet@48975
|
393 |
rtac incl_lsbis, rtac bis_diag, atac, etac @{thm diagI},
|
blanchet@48975
|
394 |
|
traytel@49488
|
395 |
rtac conjI, rtac (@{thm sym_def} RS iffD2),
|
blanchet@49305
|
396 |
rtac allI, rtac allI, rtac impI, rtac set_mp,
|
blanchet@48975
|
397 |
rtac incl_lsbis, rtac bis_converse, rtac sbis_lsbis, etac @{thm converseI},
|
blanchet@48975
|
398 |
|
traytel@49488
|
399 |
rtac (@{thm trans_def} RS iffD2),
|
blanchet@49305
|
400 |
rtac allI, rtac allI, rtac allI, rtac impI, rtac impI, rtac set_mp,
|
blanchet@48975
|
401 |
rtac incl_lsbis, rtac bis_O, rtac sbis_lsbis, rtac sbis_lsbis,
|
blanchet@48975
|
402 |
etac @{thm relcompI}, atac] 1;
|
blanchet@48975
|
403 |
|
blanchet@48975
|
404 |
fun mk_coalgT_tac m defs strT_defs set_naturalss {context = ctxt, prems = _} =
|
blanchet@48975
|
405 |
let
|
blanchet@48975
|
406 |
val n = length strT_defs;
|
blanchet@48975
|
407 |
val ks = 1 upto n;
|
blanchet@48975
|
408 |
fun coalg_tac (i, ((passive_sets, active_sets), def)) =
|
blanchet@48975
|
409 |
EVERY' [rtac ballI, REPEAT_DETERM o eresolve_tac [CollectE, exE, conjE],
|
blanchet@48975
|
410 |
hyp_subst_tac, rtac (def RS trans RS @{thm ssubst_mem}), etac (arg_cong RS trans),
|
blanchet@48975
|
411 |
rtac (mk_sum_casesN n i), rtac CollectI,
|
blanchet@49305
|
412 |
EVERY' (map (fn thm => EVERY' [rtac conjI, rtac (thm RS ord_eq_le_trans),
|
blanchet@49305
|
413 |
etac ((trans OF [@{thm image_id} RS fun_cong, @{thm id_apply}]) RS ord_eq_le_trans)])
|
blanchet@49305
|
414 |
passive_sets),
|
blanchet@49305
|
415 |
CONJ_WRAP' (fn (i, thm) => EVERY' [rtac (thm RS ord_eq_le_trans),
|
blanchet@48975
|
416 |
rtac @{thm image_subsetI}, rtac CollectI, rtac exI, rtac exI, rtac conjI, rtac refl,
|
blanchet@48975
|
417 |
rtac conjI,
|
blanchet@49305
|
418 |
rtac conjI, etac @{thm empty_Shift}, dtac set_rev_mp,
|
blanchet@48975
|
419 |
etac equalityD1, etac CollectD,
|
blanchet@48975
|
420 |
rtac conjI, etac @{thm Shift_clists},
|
blanchet@48975
|
421 |
rtac conjI, etac @{thm Shift_prefCl},
|
blanchet@48975
|
422 |
rtac conjI, rtac ballI,
|
blanchet@48975
|
423 |
rtac conjI, dtac @{thm iffD1[OF ball_conj_distrib]}, dtac conjunct1,
|
blanchet@49504
|
424 |
SELECT_GOAL (unfold_thms_tac ctxt @{thms Succ_Shift shift_def}),
|
blanchet@48975
|
425 |
etac bspec, etac @{thm ShiftD},
|
blanchet@48975
|
426 |
CONJ_WRAP' (fn i => EVERY' [rtac ballI, etac CollectE, dtac @{thm ShiftD},
|
blanchet@48975
|
427 |
dtac bspec, etac thin_rl, atac, dtac conjunct2, dtac (mk_conjunctN n i),
|
blanchet@48975
|
428 |
dtac bspec, rtac CollectI, etac @{thm set_mp[OF equalityD1[OF Succ_Shift]]},
|
blanchet@48975
|
429 |
REPEAT_DETERM o eresolve_tac [exE, conjE], rtac exI,
|
blanchet@48975
|
430 |
rtac conjI, rtac (@{thm shift_def} RS fun_cong RS trans),
|
blanchet@48975
|
431 |
rtac (@{thm append_Cons} RS sym RS arg_cong RS trans), atac,
|
blanchet@48975
|
432 |
REPEAT_DETERM_N m o (rtac conjI THEN' atac),
|
blanchet@48975
|
433 |
CONJ_WRAP' (K (EVERY' [etac trans, rtac @{thm Collect_cong},
|
blanchet@48975
|
434 |
rtac @{thm eqset_imp_iff}, rtac sym, rtac trans, rtac @{thm Succ_Shift},
|
blanchet@48975
|
435 |
rtac (@{thm append_Cons} RS sym RS arg_cong)])) ks]) ks,
|
blanchet@48975
|
436 |
rtac allI, rtac impI, REPEAT_DETERM o eresolve_tac [allE, impE],
|
blanchet@48975
|
437 |
etac @{thm not_in_Shift}, rtac trans, rtac (@{thm shift_def} RS fun_cong), atac,
|
blanchet@48975
|
438 |
dtac bspec, atac, dtac conjunct2, dtac (mk_conjunctN n i), dtac bspec,
|
blanchet@48975
|
439 |
etac @{thm set_mp[OF equalityD1]}, atac,
|
blanchet@48975
|
440 |
REPEAT_DETERM o eresolve_tac [exE, conjE], rtac exI,
|
blanchet@48975
|
441 |
rtac conjI, rtac (@{thm shift_def} RS fun_cong RS trans),
|
blanchet@48975
|
442 |
etac (@{thm append_Nil} RS sym RS arg_cong RS trans),
|
blanchet@48975
|
443 |
REPEAT_DETERM_N m o (rtac conjI THEN' atac),
|
blanchet@48975
|
444 |
CONJ_WRAP' (K (EVERY' [etac trans, rtac @{thm Collect_cong},
|
blanchet@48975
|
445 |
rtac @{thm eqset_imp_iff}, rtac sym, rtac trans, rtac @{thm Succ_Shift},
|
blanchet@48975
|
446 |
rtac (@{thm append_Nil} RS sym RS arg_cong)])) ks]) (ks ~~ active_sets)];
|
blanchet@48975
|
447 |
in
|
blanchet@49504
|
448 |
unfold_thms_tac ctxt defs THEN
|
blanchet@48975
|
449 |
CONJ_WRAP' coalg_tac (ks ~~ (map (chop m) set_naturalss ~~ strT_defs)) 1
|
blanchet@48975
|
450 |
end;
|
blanchet@48975
|
451 |
|
blanchet@48975
|
452 |
fun mk_card_of_carT_tac m isNode_defs sbd_sbd
|
blanchet@48975
|
453 |
sbd_card_order sbd_Card_order sbd_Cinfinite sbd_Cnotzero in_sbds =
|
blanchet@48975
|
454 |
let
|
blanchet@48975
|
455 |
val n = length isNode_defs;
|
blanchet@48975
|
456 |
in
|
blanchet@48975
|
457 |
EVERY' [rtac (Thm.permute_prems 0 1 ctrans),
|
blanchet@48975
|
458 |
rtac @{thm card_of_Sigma_ordLeq_Cinfinite}, rtac @{thm Cinfinite_cexp},
|
blanchet@48975
|
459 |
if m = 0 then rtac @{thm ordLeq_refl} else rtac @{thm ordLeq_csum2},
|
blanchet@48975
|
460 |
rtac @{thm Card_order_ctwo}, rtac @{thm Cinfinite_cexp},
|
blanchet@48975
|
461 |
rtac @{thm ctwo_ordLeq_Cinfinite}, rtac sbd_Cinfinite, rtac sbd_Cinfinite,
|
blanchet@48975
|
462 |
rtac ctrans, rtac @{thm card_of_diff},
|
blanchet@49305
|
463 |
rtac ordIso_ordLeq_trans, rtac @{thm card_of_Field_ordIso},
|
blanchet@49305
|
464 |
rtac @{thm Card_order_cpow}, rtac ordIso_ordLeq_trans,
|
blanchet@48975
|
465 |
rtac @{thm cpow_cexp_ctwo}, rtac ctrans, rtac @{thm cexp_mono1_Cnotzero},
|
blanchet@48975
|
466 |
if m = 0 then rtac @{thm ordLeq_refl} else rtac @{thm ordLeq_csum2},
|
blanchet@48975
|
467 |
rtac @{thm Card_order_ctwo}, rtac @{thm ctwo_Cnotzero}, rtac @{thm Card_order_clists},
|
blanchet@49305
|
468 |
rtac @{thm cexp_mono2_Cnotzero}, rtac ordIso_ordLeq_trans,
|
blanchet@48975
|
469 |
rtac @{thm clists_Cinfinite},
|
blanchet@48975
|
470 |
if n = 1 then rtac sbd_Cinfinite else rtac (sbd_Cinfinite RS @{thm Cinfinite_csum1}),
|
blanchet@49305
|
471 |
rtac ordIso_ordLeq_trans, rtac sbd_sbd, rtac @{thm infinite_ordLeq_cexp},
|
blanchet@48975
|
472 |
rtac sbd_Cinfinite,
|
blanchet@48975
|
473 |
if m = 0 then rtac @{thm ctwo_Cnotzero} else rtac @{thm csum_Cnotzero2[OF ctwo_Cnotzero]},
|
blanchet@48975
|
474 |
rtac @{thm Cnotzero_clists},
|
blanchet@49305
|
475 |
rtac ballI, rtac ordIso_ordLeq_trans, rtac @{thm card_of_Func_Ffunc},
|
blanchet@49305
|
476 |
rtac ordIso_ordLeq_trans, rtac @{thm Func_cexp},
|
blanchet@48975
|
477 |
rtac ctrans, rtac @{thm cexp_mono},
|
blanchet@48975
|
478 |
rtac @{thm ordLeq_ordIso_trans},
|
blanchet@48975
|
479 |
CONJ_WRAP_GEN' (rtac (Thm.permute_prems 0 1
|
blanchet@48975
|
480 |
(sbd_Cinfinite RS @{thm Cinfinite_cexp[OF ordLeq_csum2[OF Card_order_ctwo]]}
|
blanchet@48975
|
481 |
RSN (3, @{thm Un_Cinfinite_bound}))))
|
blanchet@48975
|
482 |
(fn thm => EVERY' [rtac ctrans, rtac @{thm card_of_image}, rtac thm]) (rev in_sbds),
|
blanchet@48975
|
483 |
rtac @{thm cexp_cong1_Cnotzero}, rtac @{thm csum_cong1},
|
blanchet@48975
|
484 |
REPEAT_DETERM_N m o rtac @{thm csum_cong2},
|
blanchet@48975
|
485 |
CONJ_WRAP_GEN' (rtac @{thm csum_cong})
|
blanchet@48975
|
486 |
(K (rtac (sbd_Card_order RS @{thm card_of_Field_ordIso}))) in_sbds,
|
blanchet@48975
|
487 |
rtac sbd_Card_order,
|
blanchet@48975
|
488 |
rtac @{thm csum_Cnotzero2}, rtac @{thm ctwo_Cnotzero},
|
blanchet@48975
|
489 |
rtac @{thm csum_Cnotzero2}, rtac @{thm ctwo_Cnotzero},
|
blanchet@48975
|
490 |
rtac @{thm ordLeq_ordIso_trans}, etac @{thm clists_bound},
|
blanchet@48975
|
491 |
rtac @{thm clists_Cinfinite}, TRY o rtac @{thm Cinfinite_csum1}, rtac sbd_Cinfinite,
|
blanchet@48975
|
492 |
rtac disjI2, rtac @{thm cone_ordLeq_cexp}, rtac @{thm cone_ordLeq_cexp},
|
blanchet@48975
|
493 |
rtac ctrans, rtac @{thm cone_ordLeq_ctwo}, rtac @{thm ordLeq_csum2},
|
blanchet@48975
|
494 |
rtac @{thm Card_order_ctwo}, rtac FalseE, etac @{thm cpow_clists_czero}, atac,
|
blanchet@48975
|
495 |
rtac @{thm card_of_Card_order},
|
blanchet@49305
|
496 |
rtac ordIso_ordLeq_trans, rtac @{thm cexp_cprod},
|
blanchet@48975
|
497 |
rtac @{thm csum_Cnotzero2}, rtac @{thm ctwo_Cnotzero},
|
blanchet@49305
|
498 |
rtac ordIso_ordLeq_trans, rtac @{thm cexp_cong2_Cnotzero},
|
blanchet@48975
|
499 |
rtac @{thm ordIso_transitive}, rtac @{thm cprod_cong2}, rtac sbd_sbd,
|
blanchet@48975
|
500 |
rtac @{thm cprod_infinite}, rtac sbd_Cinfinite,
|
blanchet@48975
|
501 |
rtac @{thm csum_Cnotzero2}, rtac @{thm ctwo_Cnotzero}, rtac @{thm Card_order_cprod},
|
blanchet@48975
|
502 |
rtac ctrans, rtac @{thm cexp_mono1_Cnotzero},
|
blanchet@49305
|
503 |
rtac ordIso_ordLeq_trans, rtac @{thm ordIso_transitive}, rtac @{thm csum_cong1},
|
blanchet@48975
|
504 |
rtac @{thm ordIso_transitive},
|
blanchet@48975
|
505 |
REPEAT_DETERM_N m o rtac @{thm csum_cong2},
|
blanchet@48975
|
506 |
rtac sbd_sbd,
|
blanchet@48975
|
507 |
BNF_Tactics.mk_rotate_eq_tac (rtac @{thm ordIso_refl} THEN'
|
blanchet@48975
|
508 |
FIRST' [rtac @{thm card_of_Card_order},
|
blanchet@48975
|
509 |
rtac @{thm Card_order_csum}, rtac sbd_Card_order])
|
blanchet@48975
|
510 |
@{thm ordIso_transitive} @{thm csum_assoc} @{thm csum_com} @{thm csum_cong}
|
blanchet@48975
|
511 |
(1 upto m + 1) (m + 1 :: (1 upto m)),
|
blanchet@48975
|
512 |
if m = 0 then K all_tac else EVERY' [rtac @{thm ordIso_transitive}, rtac @{thm csum_assoc}],
|
blanchet@48975
|
513 |
rtac @{thm csum_com}, rtac @{thm csum_cexp'}, rtac sbd_Cinfinite,
|
blanchet@48975
|
514 |
if m = 0 then rtac @{thm Card_order_ctwo} else rtac @{thm Card_order_csum},
|
blanchet@48975
|
515 |
if m = 0 then rtac @{thm ordLeq_refl} else rtac @{thm ordLeq_csum2},
|
blanchet@48975
|
516 |
rtac @{thm Card_order_ctwo},
|
blanchet@48975
|
517 |
rtac @{thm csum_Cnotzero2}, rtac @{thm ctwo_Cnotzero}, rtac sbd_Card_order,
|
blanchet@49305
|
518 |
rtac ordIso_ordLeq_trans, rtac @{thm cexp_cprod_ordLeq},
|
blanchet@48975
|
519 |
if m = 0 then rtac @{thm ctwo_Cnotzero} else rtac @{thm csum_Cnotzero2[OF ctwo_Cnotzero]},
|
blanchet@48975
|
520 |
rtac sbd_Cinfinite, rtac sbd_Cnotzero, rtac @{thm ordLeq_refl}, rtac sbd_Card_order,
|
blanchet@48975
|
521 |
rtac @{thm cexp_mono2_Cnotzero}, rtac @{thm infinite_ordLeq_cexp},
|
blanchet@48975
|
522 |
rtac sbd_Cinfinite,
|
blanchet@48975
|
523 |
if m = 0 then rtac @{thm ctwo_Cnotzero} else rtac @{thm csum_Cnotzero2[OF ctwo_Cnotzero]},
|
blanchet@48975
|
524 |
rtac sbd_Cnotzero,
|
blanchet@48975
|
525 |
rtac @{thm card_of_mono1}, rtac subsetI,
|
blanchet@48975
|
526 |
REPEAT_DETERM o eresolve_tac [CollectE, exE, conjE, @{thm prod_caseE}], hyp_subst_tac,
|
blanchet@49305
|
527 |
rtac @{thm SigmaI}, rtac @{thm DiffI}, rtac set_mp, rtac equalityD2,
|
blanchet@48975
|
528 |
rtac (@{thm cpow_def} RS arg_cong RS trans), rtac (@{thm Pow_def} RS arg_cong RS trans),
|
blanchet@48975
|
529 |
rtac @{thm Field_card_of}, rtac CollectI, atac, rtac notI, etac @{thm singletonE},
|
blanchet@49305
|
530 |
hyp_subst_tac, etac @{thm emptyE}, rtac (@{thm Ffunc_def} RS equalityD2 RS set_mp),
|
blanchet@48975
|
531 |
rtac CollectI, rtac conjI, rtac ballI, dtac bspec, etac thin_rl, atac, dtac conjunct1,
|
blanchet@48975
|
532 |
CONJ_WRAP_GEN' (etac disjE) (fn (i, def) => EVERY'
|
traytel@49488
|
533 |
[rtac (mk_UnIN n i), dtac (def RS iffD1),
|
blanchet@48975
|
534 |
REPEAT_DETERM o eresolve_tac [exE, conjE], rtac @{thm image_eqI}, atac, rtac CollectI,
|
blanchet@48975
|
535 |
REPEAT_DETERM_N m o (rtac conjI THEN' atac),
|
blanchet@49305
|
536 |
CONJ_WRAP' (K (EVERY' [etac ord_eq_le_trans, rtac subset_trans,
|
traytel@49490
|
537 |
rtac subset_UNIV, rtac equalityD2, rtac @{thm Field_card_order},
|
blanchet@48975
|
538 |
rtac sbd_card_order])) isNode_defs]) (1 upto n ~~ isNode_defs),
|
blanchet@48975
|
539 |
atac] 1
|
blanchet@48975
|
540 |
end;
|
blanchet@48975
|
541 |
|
blanchet@48975
|
542 |
fun mk_carT_set_tac n i carT_def strT_def isNode_def set_natural {context = ctxt, prems = _}=
|
blanchet@49305
|
543 |
EVERY' [dtac (carT_def RS equalityD1 RS set_mp),
|
blanchet@48975
|
544 |
REPEAT_DETERM o eresolve_tac [CollectE, exE, conjE],
|
traytel@49488
|
545 |
dtac Pair_eqD,
|
blanchet@48975
|
546 |
etac conjE, hyp_subst_tac,
|
traytel@49488
|
547 |
dtac (isNode_def RS iffD1),
|
blanchet@48975
|
548 |
REPEAT_DETERM o eresolve_tac [exE, conjE],
|
blanchet@49305
|
549 |
rtac (equalityD2 RS set_mp),
|
blanchet@48975
|
550 |
rtac (strT_def RS arg_cong RS trans),
|
blanchet@48975
|
551 |
etac (arg_cong RS trans),
|
blanchet@48975
|
552 |
fo_rtac (mk_sum_casesN n i RS arg_cong RS trans) ctxt,
|
blanchet@49305
|
553 |
rtac set_natural, rtac imageI, etac (equalityD2 RS set_mp), rtac CollectI,
|
blanchet@48975
|
554 |
etac @{thm prefCl_Succ}, atac] 1;
|
blanchet@48975
|
555 |
|
blanchet@48975
|
556 |
fun mk_strT_hset_tac n m j arg_cong_cTs cTs cts carT_defs strT_defs isNode_defs
|
blanchet@48975
|
557 |
set_incl_hsets set_hset_incl_hsetss coalg_setss carT_setss coalgT set_naturalss =
|
blanchet@48975
|
558 |
let
|
blanchet@48975
|
559 |
val set_naturals = map (fn xs => nth xs (j - 1)) set_naturalss;
|
blanchet@48975
|
560 |
val ks = 1 upto n;
|
blanchet@48975
|
561 |
fun base_tac (i, (cT, (strT_def, (set_incl_hset, set_natural)))) =
|
blanchet@48975
|
562 |
CONJ_WRAP' (fn (i', (carT_def, isNode_def)) => rtac impI THEN' etac conjE THEN'
|
blanchet@48975
|
563 |
(if i = i'
|
blanchet@48975
|
564 |
then EVERY' [rtac @{thm xt1(4)}, rtac set_incl_hset,
|
blanchet@48975
|
565 |
rtac (strT_def RS arg_cong RS trans), etac (arg_cong RS trans),
|
blanchet@48975
|
566 |
rtac (Thm.permute_prems 0 1 (set_natural RS box_equals)),
|
blanchet@48975
|
567 |
rtac (trans OF [@{thm image_id} RS fun_cong, @{thm id_apply}]),
|
blanchet@48975
|
568 |
rtac (mk_sum_casesN n i RS (Drule.instantiate' [cT] [] arg_cong) RS sym)]
|
blanchet@49305
|
569 |
else EVERY' [dtac (carT_def RS equalityD1 RS set_mp),
|
blanchet@48975
|
570 |
REPEAT_DETERM o eresolve_tac [CollectE, exE], etac conjE,
|
traytel@49488
|
571 |
dtac conjunct2, dtac Pair_eqD, etac conjE,
|
traytel@49488
|
572 |
hyp_subst_tac, dtac (isNode_def RS iffD1),
|
blanchet@48975
|
573 |
REPEAT_DETERM o eresolve_tac [exE, conjE],
|
blanchet@48975
|
574 |
rtac (mk_InN_not_InM i i' RS notE), etac (sym RS trans), atac]))
|
blanchet@48975
|
575 |
(ks ~~ (carT_defs ~~ isNode_defs));
|
blanchet@48975
|
576 |
fun step_tac (i, (coalg_sets, (carT_sets, set_hset_incl_hsets))) =
|
blanchet@48975
|
577 |
dtac (mk_conjunctN n i) THEN'
|
blanchet@48975
|
578 |
CONJ_WRAP' (fn (coalg_set, (carT_set, set_hset_incl_hset)) =>
|
blanchet@48975
|
579 |
EVERY' [rtac impI, etac conjE, etac impE, rtac conjI,
|
blanchet@49305
|
580 |
rtac (coalgT RS coalg_set RS set_mp), atac, etac carT_set, atac, atac,
|
blanchet@48975
|
581 |
etac (@{thm shift_def} RS fun_cong RS trans), etac subset_trans,
|
blanchet@48975
|
582 |
rtac set_hset_incl_hset, etac carT_set, atac, atac])
|
blanchet@48975
|
583 |
(coalg_sets ~~ (carT_sets ~~ set_hset_incl_hsets));
|
blanchet@48975
|
584 |
in
|
blanchet@48975
|
585 |
EVERY' [rtac (Drule.instantiate' cTs cts @{thm list.induct}),
|
blanchet@48975
|
586 |
REPEAT_DETERM o rtac allI, rtac impI,
|
blanchet@48975
|
587 |
CONJ_WRAP' base_tac
|
blanchet@48975
|
588 |
(ks ~~ (arg_cong_cTs ~~ (strT_defs ~~ (set_incl_hsets ~~ set_naturals)))),
|
blanchet@48975
|
589 |
REPEAT_DETERM o rtac allI, rtac impI,
|
blanchet@48975
|
590 |
REPEAT_DETERM o eresolve_tac [allE, impE], etac @{thm ShiftI},
|
blanchet@48975
|
591 |
CONJ_WRAP' (fn i => dtac (mk_conjunctN n i) THEN' rtac (mk_sumEN n) THEN'
|
blanchet@48975
|
592 |
CONJ_WRAP_GEN' (K all_tac) step_tac
|
blanchet@48975
|
593 |
(ks ~~ (drop m coalg_setss ~~ (carT_setss ~~ set_hset_incl_hsetss)))) ks] 1
|
blanchet@48975
|
594 |
end;
|
blanchet@48975
|
595 |
|
blanchet@48975
|
596 |
fun mk_isNode_hset_tac n isNode_def strT_hsets {context = ctxt, prems = _} =
|
blanchet@48975
|
597 |
let
|
blanchet@48975
|
598 |
val m = length strT_hsets;
|
blanchet@48975
|
599 |
in
|
blanchet@48975
|
600 |
if m = 0 then atac 1
|
blanchet@49504
|
601 |
else (unfold_thms_tac ctxt [isNode_def] THEN
|
blanchet@48975
|
602 |
EVERY' [REPEAT_DETERM o eresolve_tac [CollectE, exE, conjE],
|
blanchet@48975
|
603 |
rtac exI, rtac conjI, atac,
|
blanchet@48975
|
604 |
CONJ_WRAP' (fn (thm, i) => if i > m then atac
|
blanchet@48975
|
605 |
else EVERY' [rtac (thm RS subset_trans), atac, rtac conjI, atac, atac, atac])
|
blanchet@48975
|
606 |
(strT_hsets @ (replicate n mp) ~~ (1 upto (m + n)))] 1)
|
blanchet@48975
|
607 |
end;
|
blanchet@48975
|
608 |
|
blanchet@48975
|
609 |
fun mk_Lev_sbd_tac cts Lev_0s Lev_Sucs to_sbdss =
|
blanchet@48975
|
610 |
let
|
blanchet@48975
|
611 |
val n = length Lev_0s;
|
blanchet@48975
|
612 |
val ks = 1 upto n;
|
blanchet@48975
|
613 |
in
|
blanchet@49305
|
614 |
EVERY' [rtac (Drule.instantiate' [] cts nat_induct),
|
blanchet@48975
|
615 |
REPEAT_DETERM o rtac allI,
|
blanchet@48975
|
616 |
CONJ_WRAP' (fn Lev_0 =>
|
blanchet@49305
|
617 |
EVERY' (map rtac [ord_eq_le_trans, Lev_0, @{thm Nil_clists}])) Lev_0s,
|
blanchet@48975
|
618 |
REPEAT_DETERM o rtac allI,
|
blanchet@48975
|
619 |
CONJ_WRAP' (fn (Lev_Suc, to_sbds) =>
|
blanchet@49305
|
620 |
EVERY' [rtac ord_eq_le_trans, rtac Lev_Suc,
|
blanchet@48975
|
621 |
CONJ_WRAP_GEN' (rtac (Thm.permute_prems 0 1 @{thm Un_least}))
|
blanchet@48975
|
622 |
(fn (i, to_sbd) => EVERY' [rtac subsetI,
|
blanchet@48975
|
623 |
REPEAT_DETERM o eresolve_tac [CollectE, exE, conjE], hyp_subst_tac,
|
blanchet@48975
|
624 |
rtac @{thm Cons_clists}, rtac (mk_InN_Field n i), etac to_sbd,
|
blanchet@49305
|
625 |
etac set_rev_mp, REPEAT_DETERM o etac allE,
|
blanchet@48975
|
626 |
etac (mk_conjunctN n i)])
|
blanchet@48975
|
627 |
(rev (ks ~~ to_sbds))])
|
blanchet@48975
|
628 |
(Lev_Sucs ~~ to_sbdss)] 1
|
blanchet@48975
|
629 |
end;
|
blanchet@48975
|
630 |
|
blanchet@48975
|
631 |
fun mk_length_Lev_tac cts Lev_0s Lev_Sucs =
|
blanchet@48975
|
632 |
let
|
blanchet@48975
|
633 |
val n = length Lev_0s;
|
blanchet@48975
|
634 |
val ks = n downto 1;
|
blanchet@48975
|
635 |
in
|
blanchet@49305
|
636 |
EVERY' [rtac (Drule.instantiate' [] cts nat_induct),
|
blanchet@48975
|
637 |
REPEAT_DETERM o rtac allI,
|
blanchet@48975
|
638 |
CONJ_WRAP' (fn Lev_0 =>
|
blanchet@49305
|
639 |
EVERY' [rtac impI, dtac (Lev_0 RS equalityD1 RS set_mp),
|
blanchet@48975
|
640 |
etac @{thm singletonE}, etac ssubst, rtac @{thm list.size(3)}]) Lev_0s,
|
blanchet@48975
|
641 |
REPEAT_DETERM o rtac allI,
|
blanchet@48975
|
642 |
CONJ_WRAP' (fn Lev_Suc =>
|
blanchet@49305
|
643 |
EVERY' [rtac impI, dtac (Lev_Suc RS equalityD1 RS set_mp),
|
blanchet@48975
|
644 |
CONJ_WRAP_GEN' (etac (Thm.permute_prems 1 1 UnE))
|
blanchet@48975
|
645 |
(fn i => EVERY' [REPEAT_DETERM o eresolve_tac [CollectE, exE, conjE], hyp_subst_tac,
|
blanchet@48975
|
646 |
rtac trans, rtac @{thm length_Cons}, rtac @{thm arg_cong[of _ _ Suc]},
|
blanchet@48975
|
647 |
REPEAT_DETERM o etac allE, dtac (mk_conjunctN n i), etac mp, atac]) ks])
|
blanchet@48975
|
648 |
Lev_Sucs] 1
|
blanchet@48975
|
649 |
end;
|
blanchet@48975
|
650 |
|
blanchet@48975
|
651 |
fun mk_length_Lev'_tac length_Lev =
|
blanchet@48975
|
652 |
EVERY' [ftac length_Lev, etac ssubst, atac] 1;
|
blanchet@48975
|
653 |
|
blanchet@48975
|
654 |
fun mk_prefCl_Lev_tac cts Lev_0s Lev_Sucs =
|
blanchet@48975
|
655 |
let
|
blanchet@48975
|
656 |
val n = length Lev_0s;
|
blanchet@48975
|
657 |
val ks = n downto 1;
|
blanchet@48975
|
658 |
in
|
blanchet@49305
|
659 |
EVERY' [rtac (Drule.instantiate' [] cts nat_induct),
|
blanchet@48975
|
660 |
REPEAT_DETERM o rtac allI,
|
blanchet@48975
|
661 |
CONJ_WRAP' (fn Lev_0 =>
|
blanchet@49305
|
662 |
EVERY' [rtac impI, etac conjE, dtac (Lev_0 RS equalityD1 RS set_mp),
|
Christian@49091
|
663 |
etac @{thm singletonE}, hyp_subst_tac, dtac @{thm prefix_Nil[THEN subst, of "%x. x"]},
|
blanchet@48975
|
664 |
hyp_subst_tac, rtac @{thm set_mp[OF equalityD2[OF trans[OF arg_cong[OF list.size(3)]]]]},
|
blanchet@48975
|
665 |
rtac Lev_0, rtac @{thm singletonI}]) Lev_0s,
|
blanchet@48975
|
666 |
REPEAT_DETERM o rtac allI,
|
blanchet@48975
|
667 |
CONJ_WRAP' (fn (Lev_0, Lev_Suc) =>
|
blanchet@49305
|
668 |
EVERY' [rtac impI, etac conjE, dtac (Lev_Suc RS equalityD1 RS set_mp),
|
blanchet@48975
|
669 |
CONJ_WRAP_GEN' (etac (Thm.permute_prems 1 1 UnE))
|
blanchet@48975
|
670 |
(fn i => EVERY' [REPEAT_DETERM o eresolve_tac [CollectE, exE, conjE], hyp_subst_tac,
|
Christian@49091
|
671 |
dtac @{thm prefix_Cons[THEN subst, of "%x. x"]}, etac disjE, hyp_subst_tac,
|
blanchet@48975
|
672 |
rtac @{thm set_mp[OF equalityD2[OF trans[OF arg_cong[OF list.size(3)]]]]},
|
blanchet@48975
|
673 |
rtac Lev_0, rtac @{thm singletonI},
|
blanchet@48975
|
674 |
REPEAT_DETERM o eresolve_tac [exE, conjE], hyp_subst_tac,
|
blanchet@48975
|
675 |
rtac @{thm set_mp[OF equalityD2[OF trans[OF arg_cong[OF length_Cons]]]]},
|
blanchet@49366
|
676 |
rtac Lev_Suc, rtac (mk_UnIN n i), rtac CollectI, REPEAT_DETERM o rtac exI, rtac conjI,
|
blanchet@48975
|
677 |
rtac refl, etac conjI, REPEAT_DETERM o etac allE, dtac (mk_conjunctN n i),
|
blanchet@48975
|
678 |
etac mp, etac conjI, atac]) ks])
|
blanchet@48975
|
679 |
(Lev_0s ~~ Lev_Sucs)] 1
|
blanchet@48975
|
680 |
end;
|
blanchet@48975
|
681 |
|
blanchet@48975
|
682 |
fun mk_rv_last_tac cTs cts rv_Nils rv_Conss =
|
blanchet@48975
|
683 |
let
|
blanchet@48975
|
684 |
val n = length rv_Nils;
|
blanchet@48975
|
685 |
val ks = 1 upto n;
|
blanchet@48975
|
686 |
in
|
blanchet@48975
|
687 |
EVERY' [rtac (Drule.instantiate' cTs cts @{thm list.induct}),
|
blanchet@48975
|
688 |
REPEAT_DETERM o rtac allI,
|
blanchet@48975
|
689 |
CONJ_WRAP' (fn rv_Cons =>
|
blanchet@48975
|
690 |
CONJ_WRAP' (fn (i, rv_Nil) => (EVERY' [rtac exI,
|
blanchet@48975
|
691 |
rtac (@{thm append_Nil} RS arg_cong RS trans),
|
blanchet@48975
|
692 |
rtac (rv_Cons RS trans), rtac (mk_sum_casesN n i RS arg_cong RS trans), rtac rv_Nil]))
|
blanchet@48975
|
693 |
(ks ~~ rv_Nils))
|
blanchet@48975
|
694 |
rv_Conss,
|
blanchet@48975
|
695 |
REPEAT_DETERM o rtac allI, rtac (mk_sumEN n),
|
blanchet@48975
|
696 |
EVERY' (map (fn i =>
|
blanchet@48975
|
697 |
CONJ_WRAP' (fn rv_Cons => EVERY' [REPEAT_DETERM o etac allE, dtac (mk_conjunctN n i),
|
blanchet@48975
|
698 |
CONJ_WRAP' (fn i' => EVERY' [dtac (mk_conjunctN n i'), etac exE, rtac exI,
|
blanchet@48975
|
699 |
rtac (@{thm append_Cons} RS arg_cong RS trans),
|
blanchet@49328
|
700 |
rtac (rv_Cons RS trans), etac (sum_case_weak_cong RS arg_cong RS trans),
|
blanchet@48975
|
701 |
rtac (mk_sum_casesN n i RS arg_cong RS trans), atac])
|
blanchet@48975
|
702 |
ks])
|
blanchet@48975
|
703 |
rv_Conss)
|
blanchet@48975
|
704 |
ks)] 1
|
blanchet@48975
|
705 |
end;
|
blanchet@48975
|
706 |
|
blanchet@48975
|
707 |
fun mk_set_rv_Lev_tac m cts Lev_0s Lev_Sucs rv_Nils rv_Conss coalg_setss from_to_sbdss =
|
blanchet@48975
|
708 |
let
|
blanchet@48975
|
709 |
val n = length Lev_0s;
|
blanchet@48975
|
710 |
val ks = 1 upto n;
|
blanchet@48975
|
711 |
in
|
blanchet@49305
|
712 |
EVERY' [rtac (Drule.instantiate' [] cts nat_induct),
|
blanchet@48975
|
713 |
REPEAT_DETERM o rtac allI,
|
blanchet@48975
|
714 |
CONJ_WRAP' (fn (i, ((Lev_0, rv_Nil), coalg_sets)) =>
|
blanchet@48975
|
715 |
EVERY' [rtac impI, REPEAT_DETERM o etac conjE,
|
blanchet@49305
|
716 |
dtac (Lev_0 RS equalityD1 RS set_mp), etac @{thm singletonE}, etac ssubst,
|
traytel@49488
|
717 |
rtac (rv_Nil RS arg_cong RS iffD2),
|
traytel@49488
|
718 |
rtac (mk_sum_casesN n i RS iffD2),
|
blanchet@48975
|
719 |
CONJ_WRAP' (fn thm => etac thm THEN' atac) (take m coalg_sets)])
|
blanchet@48975
|
720 |
(ks ~~ ((Lev_0s ~~ rv_Nils) ~~ coalg_setss)),
|
blanchet@48975
|
721 |
REPEAT_DETERM o rtac allI,
|
blanchet@48975
|
722 |
CONJ_WRAP' (fn ((Lev_Suc, rv_Cons), (from_to_sbds, coalg_sets)) =>
|
blanchet@49305
|
723 |
EVERY' [rtac impI, etac conjE, dtac (Lev_Suc RS equalityD1 RS set_mp),
|
blanchet@48975
|
724 |
CONJ_WRAP_GEN' (etac (Thm.permute_prems 1 1 UnE))
|
blanchet@48975
|
725 |
(fn (i, (from_to_sbd, coalg_set)) =>
|
blanchet@48975
|
726 |
EVERY' [REPEAT_DETERM o eresolve_tac [CollectE, exE, conjE], hyp_subst_tac,
|
traytel@49488
|
727 |
rtac (rv_Cons RS arg_cong RS iffD2),
|
traytel@49488
|
728 |
rtac (mk_sum_casesN n i RS arg_cong RS trans RS iffD2),
|
blanchet@48975
|
729 |
etac (from_to_sbd RS arg_cong), REPEAT_DETERM o etac allE,
|
blanchet@49305
|
730 |
dtac (mk_conjunctN n i), etac mp, etac conjI, etac set_rev_mp,
|
blanchet@48975
|
731 |
etac coalg_set, atac])
|
blanchet@48975
|
732 |
(rev (ks ~~ (from_to_sbds ~~ drop m coalg_sets)))])
|
blanchet@48975
|
733 |
((Lev_Sucs ~~ rv_Conss) ~~ (from_to_sbdss ~~ coalg_setss))] 1
|
blanchet@48975
|
734 |
end;
|
blanchet@48975
|
735 |
|
blanchet@48975
|
736 |
fun mk_set_Lev_tac cts Lev_0s Lev_Sucs rv_Nils rv_Conss from_to_sbdss =
|
blanchet@48975
|
737 |
let
|
blanchet@48975
|
738 |
val n = length Lev_0s;
|
blanchet@48975
|
739 |
val ks = 1 upto n;
|
blanchet@48975
|
740 |
in
|
blanchet@49305
|
741 |
EVERY' [rtac (Drule.instantiate' [] cts nat_induct),
|
blanchet@48975
|
742 |
REPEAT_DETERM o rtac allI,
|
blanchet@48975
|
743 |
CONJ_WRAP' (fn ((i, (Lev_0, Lev_Suc)), rv_Nil) =>
|
blanchet@49305
|
744 |
EVERY' [rtac impI, dtac (Lev_0 RS equalityD1 RS set_mp),
|
blanchet@48975
|
745 |
etac @{thm singletonE}, hyp_subst_tac,
|
blanchet@48975
|
746 |
CONJ_WRAP' (fn i' => rtac impI THEN' dtac (sym RS trans) THEN' rtac rv_Nil THEN'
|
blanchet@48975
|
747 |
(if i = i'
|
blanchet@48975
|
748 |
then EVERY' [dtac (mk_InN_inject n i), hyp_subst_tac,
|
blanchet@48975
|
749 |
CONJ_WRAP' (fn (i'', Lev_0'') =>
|
blanchet@48975
|
750 |
EVERY' [rtac impI, rtac @{thm ssubst_mem[OF append_Nil]},
|
blanchet@49366
|
751 |
rtac (Lev_Suc RS equalityD2 RS set_mp), rtac (mk_UnIN n i''),
|
blanchet@48975
|
752 |
rtac CollectI, REPEAT_DETERM o rtac exI, rtac conjI, rtac refl,
|
blanchet@49305
|
753 |
etac conjI, rtac (Lev_0'' RS equalityD2 RS set_mp),
|
blanchet@48975
|
754 |
rtac @{thm singletonI}])
|
blanchet@48975
|
755 |
(ks ~~ Lev_0s)]
|
blanchet@48975
|
756 |
else etac (mk_InN_not_InM i' i RS notE)))
|
blanchet@48975
|
757 |
ks])
|
blanchet@48975
|
758 |
((ks ~~ (Lev_0s ~~ Lev_Sucs)) ~~ rv_Nils),
|
blanchet@48975
|
759 |
REPEAT_DETERM o rtac allI,
|
blanchet@48975
|
760 |
CONJ_WRAP' (fn ((Lev_Suc, rv_Cons), from_to_sbds) =>
|
blanchet@49305
|
761 |
EVERY' [rtac impI, dtac (Lev_Suc RS equalityD1 RS set_mp),
|
blanchet@48975
|
762 |
CONJ_WRAP_GEN' (etac (Thm.permute_prems 1 1 UnE))
|
blanchet@48975
|
763 |
(fn (i, from_to_sbd) =>
|
blanchet@48975
|
764 |
EVERY' [REPEAT_DETERM o eresolve_tac [CollectE, exE, conjE], hyp_subst_tac,
|
blanchet@48975
|
765 |
CONJ_WRAP' (fn i' => rtac impI THEN'
|
blanchet@48975
|
766 |
CONJ_WRAP' (fn i'' =>
|
blanchet@49305
|
767 |
EVERY' [rtac impI, rtac (Lev_Suc RS equalityD2 RS set_mp),
|
blanchet@49366
|
768 |
rtac @{thm ssubst_mem[OF append_Cons]}, rtac (mk_UnIN n i),
|
blanchet@48975
|
769 |
rtac CollectI, REPEAT_DETERM o rtac exI, rtac conjI, rtac refl,
|
blanchet@48975
|
770 |
rtac conjI, atac, dtac (sym RS trans RS sym),
|
blanchet@48975
|
771 |
rtac (rv_Cons RS trans), rtac (mk_sum_casesN n i RS trans),
|
blanchet@48975
|
772 |
etac (from_to_sbd RS arg_cong), REPEAT_DETERM o etac allE,
|
blanchet@48975
|
773 |
dtac (mk_conjunctN n i), dtac mp, atac,
|
blanchet@48975
|
774 |
dtac (mk_conjunctN n i'), dtac mp, atac,
|
blanchet@48975
|
775 |
dtac (mk_conjunctN n i''), etac mp, atac])
|
blanchet@48975
|
776 |
ks)
|
blanchet@48975
|
777 |
ks])
|
blanchet@48975
|
778 |
(rev (ks ~~ from_to_sbds))])
|
blanchet@48975
|
779 |
((Lev_Sucs ~~ rv_Conss) ~~ from_to_sbdss)] 1
|
blanchet@48975
|
780 |
end;
|
blanchet@48975
|
781 |
|
blanchet@48975
|
782 |
fun mk_set_image_Lev_tac cts Lev_0s Lev_Sucs rv_Nils rv_Conss from_to_sbdss to_sbd_injss =
|
blanchet@48975
|
783 |
let
|
blanchet@48975
|
784 |
val n = length Lev_0s;
|
blanchet@48975
|
785 |
val ks = 1 upto n;
|
blanchet@48975
|
786 |
in
|
blanchet@49305
|
787 |
EVERY' [rtac (Drule.instantiate' [] cts nat_induct),
|
blanchet@48975
|
788 |
REPEAT_DETERM o rtac allI,
|
blanchet@48975
|
789 |
CONJ_WRAP' (fn ((i, (Lev_0, Lev_Suc)), rv_Nil) =>
|
blanchet@49305
|
790 |
EVERY' [rtac impI, dtac (Lev_0 RS equalityD1 RS set_mp),
|
blanchet@48975
|
791 |
etac @{thm singletonE}, hyp_subst_tac,
|
blanchet@48975
|
792 |
CONJ_WRAP' (fn i' => rtac impI THEN'
|
blanchet@48975
|
793 |
CONJ_WRAP' (fn i'' => rtac impI THEN' dtac (sym RS trans) THEN' rtac rv_Nil THEN'
|
blanchet@48975
|
794 |
(if i = i''
|
blanchet@48975
|
795 |
then EVERY' [dtac @{thm ssubst_mem[OF sym[OF append_Nil]]},
|
blanchet@49305
|
796 |
dtac (Lev_Suc RS equalityD1 RS set_mp), dtac (mk_InN_inject n i),
|
blanchet@48975
|
797 |
hyp_subst_tac,
|
blanchet@48975
|
798 |
CONJ_WRAP_GEN' (etac (Thm.permute_prems 1 1 UnE))
|
blanchet@48975
|
799 |
(fn k => REPEAT_DETERM o eresolve_tac [CollectE, exE, conjE] THEN'
|
traytel@49488
|
800 |
dtac list_inject_iffD1 THEN' etac conjE THEN'
|
blanchet@48975
|
801 |
(if k = i'
|
blanchet@48975
|
802 |
then EVERY' [dtac (mk_InN_inject n k), hyp_subst_tac, etac imageI]
|
blanchet@48975
|
803 |
else etac (mk_InN_not_InM i' k RS notE)))
|
blanchet@48975
|
804 |
(rev ks)]
|
blanchet@48975
|
805 |
else etac (mk_InN_not_InM i'' i RS notE)))
|
blanchet@48975
|
806 |
ks)
|
blanchet@48975
|
807 |
ks])
|
blanchet@48975
|
808 |
((ks ~~ (Lev_0s ~~ Lev_Sucs)) ~~ rv_Nils),
|
blanchet@48975
|
809 |
REPEAT_DETERM o rtac allI,
|
blanchet@48975
|
810 |
CONJ_WRAP' (fn ((Lev_Suc, rv_Cons), (from_to_sbds, to_sbd_injs)) =>
|
blanchet@49305
|
811 |
EVERY' [rtac impI, dtac (Lev_Suc RS equalityD1 RS set_mp),
|
blanchet@48975
|
812 |
CONJ_WRAP_GEN' (etac (Thm.permute_prems 1 1 UnE))
|
blanchet@48975
|
813 |
(fn (i, (from_to_sbd, to_sbd_inj)) =>
|
blanchet@48975
|
814 |
REPEAT_DETERM o eresolve_tac [CollectE, exE, conjE] THEN' hyp_subst_tac THEN'
|
blanchet@48975
|
815 |
CONJ_WRAP' (fn i' => rtac impI THEN'
|
blanchet@48975
|
816 |
dtac @{thm ssubst_mem[OF sym[OF append_Cons]]} THEN'
|
blanchet@49305
|
817 |
dtac (Lev_Suc RS equalityD1 RS set_mp) THEN'
|
blanchet@48975
|
818 |
CONJ_WRAP_GEN' (etac (Thm.permute_prems 1 1 UnE)) (fn k =>
|
blanchet@48975
|
819 |
REPEAT_DETERM o eresolve_tac [CollectE, exE, conjE] THEN'
|
traytel@49488
|
820 |
dtac list_inject_iffD1 THEN' etac conjE THEN'
|
blanchet@48975
|
821 |
(if k = i
|
blanchet@48975
|
822 |
then EVERY' [dtac (mk_InN_inject n i),
|
traytel@49488
|
823 |
dtac (Thm.permute_prems 0 2 (to_sbd_inj RS iffD1)),
|
blanchet@48975
|
824 |
atac, atac, hyp_subst_tac] THEN'
|
blanchet@48975
|
825 |
CONJ_WRAP' (fn i'' =>
|
blanchet@48975
|
826 |
EVERY' [rtac impI, dtac (sym RS trans),
|
blanchet@48975
|
827 |
rtac (rv_Cons RS trans), rtac (mk_sum_casesN n i RS arg_cong RS trans),
|
blanchet@48975
|
828 |
etac (from_to_sbd RS arg_cong),
|
blanchet@48975
|
829 |
REPEAT_DETERM o etac allE,
|
blanchet@48975
|
830 |
dtac (mk_conjunctN n i), dtac mp, atac,
|
blanchet@48975
|
831 |
dtac (mk_conjunctN n i'), dtac mp, atac,
|
blanchet@48975
|
832 |
dtac (mk_conjunctN n i''), etac mp, etac sym])
|
blanchet@48975
|
833 |
ks
|
blanchet@48975
|
834 |
else etac (mk_InN_not_InM i k RS notE)))
|
blanchet@48975
|
835 |
(rev ks))
|
blanchet@48975
|
836 |
ks)
|
blanchet@48975
|
837 |
(rev (ks ~~ (from_to_sbds ~~ to_sbd_injs)))])
|
blanchet@48975
|
838 |
((Lev_Sucs ~~ rv_Conss) ~~ (from_to_sbdss ~~ to_sbd_injss))] 1
|
blanchet@48975
|
839 |
end;
|
blanchet@48975
|
840 |
|
blanchet@48975
|
841 |
fun mk_mor_beh_tac m mor_def mor_cong beh_defs carT_defs strT_defs isNode_defs
|
blanchet@48975
|
842 |
to_sbd_injss from_to_sbdss Lev_0s Lev_Sucs rv_Nils rv_Conss Lev_sbds length_Levs length_Lev's
|
blanchet@48975
|
843 |
prefCl_Levs rv_lastss set_rv_Levsss set_Levsss set_image_Levsss set_naturalss coalg_setss
|
blanchet@48975
|
844 |
map_comp_ids map_congs map_arg_congs {context = ctxt, prems = _} =
|
blanchet@48975
|
845 |
let
|
blanchet@48975
|
846 |
val n = length beh_defs;
|
blanchet@48975
|
847 |
val ks = 1 upto n;
|
blanchet@48975
|
848 |
|
blanchet@48975
|
849 |
fun fbetw_tac (i, (carT_def, (isNode_def, (Lev_0, (rv_Nil, (Lev_sbd,
|
blanchet@48975
|
850 |
((length_Lev, length_Lev'), (prefCl_Lev, (rv_lasts, (set_naturals,
|
blanchet@48975
|
851 |
(coalg_sets, (set_rv_Levss, (set_Levss, set_image_Levss))))))))))))) =
|
blanchet@49305
|
852 |
EVERY' [rtac ballI, rtac (carT_def RS equalityD2 RS set_mp),
|
blanchet@48975
|
853 |
rtac CollectI, REPEAT_DETERM o rtac exI, rtac conjI, rtac refl, rtac conjI,
|
blanchet@48975
|
854 |
rtac conjI,
|
blanchet@49305
|
855 |
rtac @{thm UN_I}, rtac UNIV_I, rtac (Lev_0 RS equalityD2 RS set_mp),
|
blanchet@48975
|
856 |
rtac @{thm singletonI},
|
blanchet@48975
|
857 |
rtac conjI,
|
blanchet@48975
|
858 |
rtac @{thm UN_least}, rtac Lev_sbd,
|
blanchet@48975
|
859 |
rtac conjI,
|
blanchet@48975
|
860 |
rtac @{thm prefCl_UN}, rtac ssubst, rtac @{thm PrefCl_def}, REPEAT_DETERM o rtac allI,
|
blanchet@48975
|
861 |
rtac impI, etac conjE, rtac exI, rtac conjI, rtac @{thm ord_le_eq_trans},
|
Christian@49091
|
862 |
etac @{thm prefix_length_le}, etac length_Lev, rtac prefCl_Lev, etac conjI, atac,
|
blanchet@48975
|
863 |
rtac conjI,
|
blanchet@48975
|
864 |
rtac ballI, etac @{thm UN_E}, rtac conjI,
|
blanchet@48975
|
865 |
if n = 1 then K all_tac else rtac (mk_sumEN n),
|
blanchet@48975
|
866 |
EVERY' (map6 (fn i => fn isNode_def => fn set_naturals =>
|
blanchet@48975
|
867 |
fn set_rv_Levs => fn set_Levs => fn set_image_Levs =>
|
blanchet@48975
|
868 |
EVERY' [rtac (mk_disjIN n i), rtac (isNode_def RS ssubst),
|
blanchet@48975
|
869 |
rtac exI, rtac conjI,
|
blanchet@48975
|
870 |
(if n = 1 then rtac @{thm if_P} THEN' etac length_Lev'
|
blanchet@48975
|
871 |
else rtac (@{thm if_P} RS arg_cong RS trans) THEN' etac length_Lev' THEN'
|
blanchet@49328
|
872 |
etac (sum_case_weak_cong RS trans) THEN' rtac (mk_sum_casesN n i)),
|
blanchet@48975
|
873 |
EVERY' (map2 (fn set_natural => fn set_rv_Lev =>
|
blanchet@49305
|
874 |
EVERY' [rtac conjI, rtac ord_eq_le_trans, rtac (set_natural RS trans),
|
blanchet@49305
|
875 |
rtac trans_fun_cong_image_id_id_apply,
|
blanchet@48975
|
876 |
etac set_rv_Lev, TRY o atac, etac conjI, atac])
|
blanchet@48975
|
877 |
(take m set_naturals) set_rv_Levs),
|
blanchet@48975
|
878 |
CONJ_WRAP' (fn (set_natural, (set_Lev, set_image_Lev)) =>
|
blanchet@48975
|
879 |
EVERY' [rtac (set_natural RS trans), rtac equalityI, rtac @{thm image_subsetI},
|
blanchet@48975
|
880 |
rtac CollectI, rtac @{thm SuccI}, rtac @{thm UN_I}, rtac UNIV_I, etac set_Lev,
|
blanchet@48975
|
881 |
if n = 1 then rtac refl else atac, atac, rtac subsetI,
|
blanchet@48975
|
882 |
REPEAT_DETERM o eresolve_tac [CollectE, @{thm SuccE}, @{thm UN_E}],
|
blanchet@48975
|
883 |
rtac set_image_Lev, atac, dtac length_Lev, hyp_subst_tac, dtac length_Lev',
|
blanchet@48975
|
884 |
etac @{thm set_mp[OF equalityD1[OF arg_cong[OF length_append_singleton]]]},
|
blanchet@48975
|
885 |
if n = 1 then rtac refl else atac])
|
blanchet@48975
|
886 |
(drop m set_naturals ~~ (set_Levs ~~ set_image_Levs))])
|
blanchet@48975
|
887 |
ks isNode_defs set_naturalss set_rv_Levss set_Levss set_image_Levss),
|
blanchet@48975
|
888 |
CONJ_WRAP' (fn (i, (rv_last, (isNode_def, (set_naturals,
|
blanchet@48975
|
889 |
(set_rv_Levs, (set_Levs, set_image_Levs)))))) =>
|
blanchet@48975
|
890 |
EVERY' [rtac ballI,
|
blanchet@48975
|
891 |
REPEAT_DETERM o eresolve_tac [CollectE, @{thm SuccE}, @{thm UN_E}],
|
blanchet@48975
|
892 |
rtac (rev_mp OF [rv_last, impI]), etac exE, rtac (isNode_def RS ssubst),
|
blanchet@48975
|
893 |
rtac exI, rtac conjI,
|
blanchet@48975
|
894 |
(if n = 1 then rtac @{thm if_P} THEN' etac length_Lev'
|
blanchet@48975
|
895 |
else rtac (@{thm if_P} RS trans) THEN' etac length_Lev' THEN'
|
blanchet@49328
|
896 |
etac (sum_case_weak_cong RS trans) THEN' rtac (mk_sum_casesN n i)),
|
blanchet@48975
|
897 |
EVERY' (map2 (fn set_natural => fn set_rv_Lev =>
|
blanchet@49305
|
898 |
EVERY' [rtac conjI, rtac ord_eq_le_trans, rtac (set_natural RS trans),
|
blanchet@49305
|
899 |
rtac trans_fun_cong_image_id_id_apply,
|
blanchet@48975
|
900 |
etac set_rv_Lev, TRY o atac, etac conjI, atac])
|
blanchet@48975
|
901 |
(take m set_naturals) set_rv_Levs),
|
blanchet@48975
|
902 |
CONJ_WRAP' (fn (set_natural, (set_Lev, set_image_Lev)) =>
|
blanchet@48975
|
903 |
EVERY' [rtac (set_natural RS trans), rtac equalityI, rtac @{thm image_subsetI},
|
blanchet@48975
|
904 |
rtac CollectI, rtac @{thm SuccI}, rtac @{thm UN_I}, rtac UNIV_I, etac set_Lev,
|
blanchet@48975
|
905 |
if n = 1 then rtac refl else atac, atac, rtac subsetI,
|
blanchet@48975
|
906 |
REPEAT_DETERM o eresolve_tac [CollectE, @{thm SuccE}, @{thm UN_E}],
|
blanchet@48975
|
907 |
REPEAT_DETERM_N 4 o etac thin_rl,
|
blanchet@48975
|
908 |
rtac set_image_Lev,
|
blanchet@48975
|
909 |
atac, dtac length_Lev, hyp_subst_tac, dtac length_Lev',
|
blanchet@48975
|
910 |
etac @{thm set_mp[OF equalityD1[OF arg_cong[OF length_append_singleton]]]},
|
blanchet@48975
|
911 |
if n = 1 then rtac refl else atac])
|
blanchet@48975
|
912 |
(drop m set_naturals ~~ (set_Levs ~~ set_image_Levs))])
|
blanchet@48975
|
913 |
(ks ~~ (rv_lasts ~~ (isNode_defs ~~ (set_naturalss ~~
|
blanchet@48975
|
914 |
(set_rv_Levss ~~ (set_Levss ~~ set_image_Levss)))))),
|
blanchet@48975
|
915 |
(**)
|
blanchet@48975
|
916 |
rtac allI, rtac impI, rtac @{thm if_not_P}, rtac notI,
|
blanchet@48975
|
917 |
etac notE, etac @{thm UN_I[OF UNIV_I]},
|
blanchet@48975
|
918 |
(*root isNode*)
|
blanchet@48975
|
919 |
rtac (isNode_def RS ssubst), rtac exI, rtac conjI, rtac (@{thm if_P} RS trans),
|
blanchet@49305
|
920 |
rtac length_Lev', rtac (Lev_0 RS equalityD2 RS set_mp), rtac @{thm singletonI},
|
blanchet@48975
|
921 |
CONVERSION (Conv.top_conv
|
blanchet@48975
|
922 |
(K (Conv.try_conv (Conv.rewr_conv (rv_Nil RS eq_reflection)))) ctxt),
|
blanchet@48975
|
923 |
if n = 1 then rtac refl else rtac (mk_sum_casesN n i),
|
blanchet@48975
|
924 |
EVERY' (map2 (fn set_natural => fn coalg_set =>
|
blanchet@49305
|
925 |
EVERY' [rtac conjI, rtac ord_eq_le_trans, rtac (set_natural RS trans),
|
blanchet@49305
|
926 |
rtac trans_fun_cong_image_id_id_apply, etac coalg_set, atac])
|
blanchet@48975
|
927 |
(take m set_naturals) (take m coalg_sets)),
|
blanchet@48975
|
928 |
CONJ_WRAP' (fn (set_natural, (set_Lev, set_image_Lev)) =>
|
blanchet@48975
|
929 |
EVERY' [rtac (set_natural RS trans), rtac equalityI, rtac @{thm image_subsetI},
|
blanchet@48975
|
930 |
rtac CollectI, rtac @{thm SuccI}, rtac @{thm UN_I}, rtac UNIV_I, rtac set_Lev,
|
blanchet@49305
|
931 |
rtac (Lev_0 RS equalityD2 RS set_mp), rtac @{thm singletonI}, rtac rv_Nil,
|
blanchet@48975
|
932 |
atac, rtac subsetI,
|
blanchet@48975
|
933 |
REPEAT_DETERM o eresolve_tac [CollectE, @{thm SuccE}, @{thm UN_E}],
|
blanchet@49305
|
934 |
rtac set_image_Lev, rtac (Lev_0 RS equalityD2 RS set_mp),
|
blanchet@48975
|
935 |
rtac @{thm singletonI}, dtac length_Lev',
|
blanchet@48975
|
936 |
etac @{thm set_mp[OF equalityD1[OF arg_cong[OF
|
blanchet@48975
|
937 |
trans[OF length_append_singleton arg_cong[of _ _ Suc, OF list.size(3)]]]]]},
|
blanchet@48975
|
938 |
rtac rv_Nil])
|
blanchet@48975
|
939 |
(drop m set_naturals ~~ (nth set_Levss (i - 1) ~~ nth set_image_Levss (i - 1)))];
|
blanchet@48975
|
940 |
|
blanchet@48975
|
941 |
fun mor_tac (i, (strT_def, (((Lev_0, Lev_Suc), (rv_Nil, rv_Cons)),
|
blanchet@48975
|
942 |
((map_comp_id, (map_cong, map_arg_cong)), (length_Lev', (from_to_sbds, to_sbd_injs)))))) =
|
blanchet@48975
|
943 |
EVERY' [rtac ballI, rtac sym, rtac trans, rtac strT_def,
|
blanchet@48975
|
944 |
rtac (@{thm if_P} RS
|
blanchet@49328
|
945 |
(if n = 1 then map_arg_cong else sum_case_weak_cong) RS trans),
|
blanchet@49305
|
946 |
rtac (@{thm list.size(3)} RS arg_cong RS trans RS equalityD2 RS set_mp),
|
blanchet@48975
|
947 |
rtac Lev_0, rtac @{thm singletonI},
|
blanchet@48975
|
948 |
CONVERSION (Conv.top_conv
|
blanchet@48975
|
949 |
(K (Conv.try_conv (Conv.rewr_conv (rv_Nil RS eq_reflection)))) ctxt),
|
blanchet@48975
|
950 |
if n = 1 then K all_tac
|
blanchet@49328
|
951 |
else (rtac (sum_case_weak_cong RS trans) THEN'
|
blanchet@48975
|
952 |
rtac (mk_sum_casesN n i) THEN' rtac (mk_sum_casesN n i RS trans)),
|
blanchet@48975
|
953 |
rtac (map_comp_id RS trans), rtac (map_cong OF replicate m refl),
|
blanchet@48975
|
954 |
EVERY' (map3 (fn i' => fn to_sbd_inj => fn from_to_sbd =>
|
traytel@49488
|
955 |
DETERM o EVERY' [rtac trans, rtac o_apply, rtac Pair_eqI, rtac conjI,
|
blanchet@48975
|
956 |
rtac trans, rtac @{thm Shift_def},
|
blanchet@48975
|
957 |
rtac equalityI, rtac subsetI, etac thin_rl, etac thin_rl,
|
blanchet@48975
|
958 |
REPEAT_DETERM o eresolve_tac [CollectE, @{thm UN_E}], dtac length_Lev', dtac asm_rl,
|
blanchet@48975
|
959 |
etac thin_rl, dtac @{thm set_rev_mp[OF _ equalityD1]},
|
blanchet@48975
|
960 |
rtac (@{thm length_Cons} RS arg_cong RS trans), rtac Lev_Suc,
|
blanchet@48975
|
961 |
CONJ_WRAP_GEN' (etac (Thm.permute_prems 1 1 UnE)) (fn i'' =>
|
blanchet@48975
|
962 |
EVERY' [REPEAT_DETERM o eresolve_tac [CollectE, exE, conjE],
|
traytel@49488
|
963 |
dtac list_inject_iffD1, etac conjE,
|
blanchet@48975
|
964 |
if i' = i'' then EVERY' [dtac (mk_InN_inject n i'),
|
traytel@49488
|
965 |
dtac (Thm.permute_prems 0 2 (to_sbd_inj RS iffD1)),
|
blanchet@48975
|
966 |
atac, atac, hyp_subst_tac, etac @{thm UN_I[OF UNIV_I]}]
|
blanchet@48975
|
967 |
else etac (mk_InN_not_InM i' i'' RS notE)])
|
blanchet@48975
|
968 |
(rev ks),
|
blanchet@48975
|
969 |
rtac @{thm UN_least}, rtac subsetI, rtac CollectI, rtac @{thm UN_I[OF UNIV_I]},
|
blanchet@49366
|
970 |
rtac (Lev_Suc RS equalityD2 RS set_mp), rtac (mk_UnIN n i'), rtac CollectI,
|
blanchet@48975
|
971 |
REPEAT_DETERM o rtac exI, rtac conjI, rtac refl, etac conjI, atac,
|
blanchet@48975
|
972 |
rtac trans, rtac @{thm shift_def}, rtac ssubst, rtac @{thm fun_eq_iff}, rtac allI,
|
blanchet@48975
|
973 |
rtac @{thm if_cong}, rtac (@{thm length_Cons} RS arg_cong RS trans), rtac iffI,
|
blanchet@48975
|
974 |
dtac asm_rl, dtac asm_rl, dtac asm_rl,
|
blanchet@49305
|
975 |
dtac (Lev_Suc RS equalityD1 RS set_mp),
|
blanchet@48975
|
976 |
CONJ_WRAP_GEN' (etac (Thm.permute_prems 1 1 UnE)) (fn i'' =>
|
blanchet@48975
|
977 |
EVERY' [REPEAT_DETERM o eresolve_tac [CollectE, exE, conjE],
|
traytel@49488
|
978 |
dtac list_inject_iffD1, etac conjE,
|
blanchet@48975
|
979 |
if i' = i'' then EVERY' [dtac (mk_InN_inject n i'),
|
traytel@49488
|
980 |
dtac (Thm.permute_prems 0 2 (to_sbd_inj RS iffD1)),
|
blanchet@48975
|
981 |
atac, atac, hyp_subst_tac, atac]
|
blanchet@48975
|
982 |
else etac (mk_InN_not_InM i' i'' RS notE)])
|
blanchet@48975
|
983 |
(rev ks),
|
blanchet@49366
|
984 |
rtac (Lev_Suc RS equalityD2 RS set_mp), rtac (mk_UnIN n i'), rtac CollectI,
|
blanchet@48975
|
985 |
REPEAT_DETERM o rtac exI, rtac conjI, rtac refl, etac conjI, atac,
|
blanchet@48975
|
986 |
CONVERSION (Conv.top_conv
|
blanchet@48975
|
987 |
(K (Conv.try_conv (Conv.rewr_conv (rv_Cons RS eq_reflection)))) ctxt),
|
blanchet@48975
|
988 |
if n = 1 then K all_tac
|
blanchet@49328
|
989 |
else rtac sum_case_weak_cong THEN' rtac (mk_sum_casesN n i' RS trans),
|
blanchet@49504
|
990 |
SELECT_GOAL (unfold_thms_tac ctxt [from_to_sbd]), rtac refl,
|
blanchet@48975
|
991 |
rtac refl])
|
blanchet@48975
|
992 |
ks to_sbd_injs from_to_sbds)];
|
blanchet@48975
|
993 |
in
|
blanchet@48975
|
994 |
(rtac mor_cong THEN'
|
blanchet@48975
|
995 |
EVERY' (map (fn thm => rtac (thm RS ext)) beh_defs) THEN'
|
blanchet@48975
|
996 |
stac mor_def THEN' rtac conjI THEN'
|
blanchet@48975
|
997 |
CONJ_WRAP' fbetw_tac
|
blanchet@48975
|
998 |
(ks ~~ (carT_defs ~~ (isNode_defs ~~ (Lev_0s ~~ (rv_Nils ~~ (Lev_sbds ~~
|
blanchet@48975
|
999 |
((length_Levs ~~ length_Lev's) ~~ (prefCl_Levs ~~ (rv_lastss ~~
|
blanchet@48975
|
1000 |
(set_naturalss ~~ (coalg_setss ~~
|
blanchet@48975
|
1001 |
(set_rv_Levsss ~~ (set_Levsss ~~ set_image_Levsss))))))))))))) THEN'
|
blanchet@48975
|
1002 |
CONJ_WRAP' mor_tac
|
blanchet@48975
|
1003 |
(ks ~~ (strT_defs ~~ (((Lev_0s ~~ Lev_Sucs) ~~ (rv_Nils ~~ rv_Conss)) ~~
|
blanchet@48975
|
1004 |
((map_comp_ids ~~ (map_congs ~~ map_arg_congs)) ~~
|
blanchet@48975
|
1005 |
(length_Lev's ~~ (from_to_sbdss ~~ to_sbd_injss))))))) 1
|
blanchet@48975
|
1006 |
end;
|
blanchet@48975
|
1007 |
|
blanchet@48975
|
1008 |
fun mk_congruent_str_final_tac m lsbisE map_comp_id map_cong equiv_LSBISs =
|
blanchet@48975
|
1009 |
EVERY' [rtac @{thm congruentI}, dtac lsbisE,
|
blanchet@48975
|
1010 |
REPEAT_DETERM o eresolve_tac [CollectE, conjE, bexE], rtac (o_apply RS trans),
|
blanchet@48975
|
1011 |
etac (sym RS arg_cong RS trans), rtac (map_comp_id RS trans),
|
blanchet@48975
|
1012 |
rtac (map_cong RS trans), REPEAT_DETERM_N m o rtac refl,
|
blanchet@48975
|
1013 |
EVERY' (map (fn equiv_LSBIS =>
|
blanchet@49305
|
1014 |
EVERY' [rtac @{thm equiv_proj}, rtac equiv_LSBIS, etac set_mp, atac])
|
blanchet@48975
|
1015 |
equiv_LSBISs), rtac sym, rtac (o_apply RS trans),
|
blanchet@48975
|
1016 |
etac (sym RS arg_cong RS trans), rtac map_comp_id] 1;
|
blanchet@48975
|
1017 |
|
blanchet@48975
|
1018 |
fun mk_coalg_final_tac m coalg_def congruent_str_finals equiv_LSBISs set_naturalss coalgT_setss =
|
blanchet@48975
|
1019 |
EVERY' [stac coalg_def,
|
blanchet@48975
|
1020 |
CONJ_WRAP' (fn ((set_naturals, coalgT_sets), (equiv_LSBIS, congruent_str_final)) =>
|
blanchet@48975
|
1021 |
EVERY' [rtac @{thm univ_preserves}, rtac equiv_LSBIS, rtac congruent_str_final,
|
blanchet@48975
|
1022 |
rtac ballI, rtac @{thm ssubst_mem}, rtac o_apply, rtac CollectI,
|
blanchet@48975
|
1023 |
EVERY' (map2 (fn set_natural => fn coalgT_set =>
|
blanchet@49305
|
1024 |
EVERY' [rtac conjI, rtac (set_natural RS ord_eq_le_trans),
|
blanchet@49305
|
1025 |
rtac ord_eq_le_trans_trans_fun_cong_image_id_id_apply,
|
blanchet@48975
|
1026 |
etac coalgT_set])
|
blanchet@48975
|
1027 |
(take m set_naturals) (take m coalgT_sets)),
|
blanchet@48975
|
1028 |
CONJ_WRAP' (fn (equiv_LSBIS, (set_natural, coalgT_set)) =>
|
blanchet@49305
|
1029 |
EVERY' [rtac (set_natural RS ord_eq_le_trans),
|
blanchet@48975
|
1030 |
rtac @{thm image_subsetI}, rtac ssubst, rtac @{thm proj_in_iff},
|
blanchet@49305
|
1031 |
rtac equiv_LSBIS, etac set_rev_mp, etac coalgT_set])
|
blanchet@48975
|
1032 |
(equiv_LSBISs ~~ drop m (set_naturals ~~ coalgT_sets))])
|
blanchet@48975
|
1033 |
((set_naturalss ~~ coalgT_setss) ~~ (equiv_LSBISs ~~ congruent_str_finals))] 1;
|
blanchet@48975
|
1034 |
|
blanchet@48975
|
1035 |
fun mk_mor_T_final_tac mor_def congruent_str_finals equiv_LSBISs =
|
blanchet@48975
|
1036 |
EVERY' [stac mor_def, rtac conjI,
|
blanchet@48975
|
1037 |
CONJ_WRAP' (fn equiv_LSBIS =>
|
blanchet@48975
|
1038 |
EVERY' [rtac ballI, rtac ssubst, rtac @{thm proj_in_iff}, rtac equiv_LSBIS, atac])
|
blanchet@48975
|
1039 |
equiv_LSBISs,
|
blanchet@48975
|
1040 |
CONJ_WRAP' (fn (equiv_LSBIS, congruent_str_final) =>
|
blanchet@48975
|
1041 |
EVERY' [rtac ballI, rtac sym, rtac trans, rtac @{thm univ_commute}, rtac equiv_LSBIS,
|
blanchet@48975
|
1042 |
rtac congruent_str_final, atac, rtac o_apply])
|
blanchet@48975
|
1043 |
(equiv_LSBISs ~~ congruent_str_finals)] 1;
|
blanchet@48975
|
1044 |
|
blanchet@48975
|
1045 |
fun mk_mor_Rep_tac m defs Reps Abs_inverses coalg_final_setss map_comp_ids map_congLs
|
blanchet@48975
|
1046 |
{context = ctxt, prems = _} =
|
blanchet@49504
|
1047 |
unfold_thms_tac ctxt defs THEN
|
blanchet@48975
|
1048 |
EVERY' [rtac conjI,
|
blanchet@48975
|
1049 |
CONJ_WRAP' (fn thm => rtac ballI THEN' rtac thm) Reps,
|
blanchet@48975
|
1050 |
CONJ_WRAP' (fn (Rep, ((map_comp_id, map_congL), coalg_final_sets)) =>
|
blanchet@48975
|
1051 |
EVERY' [rtac ballI, rtac (map_comp_id RS trans), rtac map_congL,
|
blanchet@48975
|
1052 |
EVERY' (map2 (fn Abs_inverse => fn coalg_final_set =>
|
blanchet@48975
|
1053 |
EVERY' [rtac ballI, rtac (o_apply RS trans), rtac Abs_inverse,
|
blanchet@49305
|
1054 |
etac set_rev_mp, rtac coalg_final_set, rtac Rep])
|
blanchet@48975
|
1055 |
Abs_inverses (drop m coalg_final_sets))])
|
blanchet@48975
|
1056 |
(Reps ~~ ((map_comp_ids ~~ map_congLs) ~~ coalg_final_setss))] 1;
|
blanchet@48975
|
1057 |
|
blanchet@48975
|
1058 |
fun mk_mor_Abs_tac defs Abs_inverses {context = ctxt, prems = _} =
|
blanchet@49504
|
1059 |
unfold_thms_tac ctxt defs THEN
|
blanchet@48975
|
1060 |
EVERY' [rtac conjI,
|
blanchet@48975
|
1061 |
CONJ_WRAP' (K (rtac ballI THEN' rtac UNIV_I)) Abs_inverses,
|
blanchet@48975
|
1062 |
CONJ_WRAP' (fn thm => rtac ballI THEN' etac (thm RS arg_cong RS sym)) Abs_inverses] 1;
|
blanchet@48975
|
1063 |
|
blanchet@49504
|
1064 |
fun mk_mor_unfold_tac m mor_UNIV dtor_defs unfold_defs Abs_inverses morEs map_comp_ids map_congs =
|
traytel@49488
|
1065 |
EVERY' [rtac iffD2, rtac mor_UNIV,
|
blanchet@49504
|
1066 |
CONJ_WRAP' (fn ((Abs_inverse, morE), ((dtor_def, unfold_def), (map_comp_id, map_cong))) =>
|
blanchet@49501
|
1067 |
EVERY' [rtac ext, rtac (o_apply RS trans RS sym), rtac (dtor_def RS trans),
|
blanchet@49504
|
1068 |
rtac (unfold_def RS arg_cong RS trans), rtac (Abs_inverse RS arg_cong RS trans),
|
blanchet@48975
|
1069 |
rtac (morE RS arg_cong RS trans), rtac (map_comp_id RS trans),
|
blanchet@48975
|
1070 |
rtac (o_apply RS trans RS sym), rtac map_cong,
|
blanchet@48975
|
1071 |
REPEAT_DETERM_N m o rtac refl,
|
blanchet@49504
|
1072 |
EVERY' (map (fn thm => rtac (thm RS trans) THEN' rtac (o_apply RS sym)) unfold_defs)])
|
blanchet@49504
|
1073 |
((Abs_inverses ~~ morEs) ~~ ((dtor_defs ~~ unfold_defs) ~~ (map_comp_ids ~~ map_congs)))] 1;
|
blanchet@48975
|
1074 |
|
blanchet@48975
|
1075 |
fun mk_raw_coind_tac bis_def bis_cong bis_O bis_converse bis_Gr tcoalg coalgT mor_T_final
|
blanchet@48975
|
1076 |
sbis_lsbis lsbis_incls incl_lsbiss equiv_LSBISs mor_Rep Rep_injects =
|
blanchet@48975
|
1077 |
let
|
blanchet@48975
|
1078 |
val n = length Rep_injects;
|
blanchet@48975
|
1079 |
in
|
traytel@49488
|
1080 |
EVERY' [rtac rev_mp, ftac (bis_def RS iffD1),
|
blanchet@48975
|
1081 |
REPEAT_DETERM o etac conjE, rtac bis_cong, rtac bis_O, rtac bis_converse,
|
blanchet@48975
|
1082 |
rtac bis_Gr, rtac tcoalg, rtac mor_Rep, rtac bis_O, atac, rtac bis_Gr, rtac tcoalg,
|
blanchet@48975
|
1083 |
rtac mor_Rep, REPEAT_DETERM_N n o etac @{thm relImage_Gr},
|
blanchet@48975
|
1084 |
rtac impI, rtac rev_mp, rtac bis_cong, rtac bis_O, rtac bis_Gr, rtac coalgT,
|
blanchet@48975
|
1085 |
rtac mor_T_final, rtac bis_O, rtac sbis_lsbis, rtac bis_converse, rtac bis_Gr, rtac coalgT,
|
blanchet@48975
|
1086 |
rtac mor_T_final, EVERY' (map (fn thm => rtac (thm RS @{thm relInvImage_Gr})) lsbis_incls),
|
blanchet@48975
|
1087 |
rtac impI,
|
blanchet@48975
|
1088 |
CONJ_WRAP' (fn (Rep_inject, (equiv_LSBIS , (incl_lsbis, lsbis_incl))) =>
|
blanchet@48975
|
1089 |
EVERY' [rtac subset_trans, rtac @{thm relInvImage_UNIV_relImage}, rtac subset_trans,
|
blanchet@48975
|
1090 |
rtac @{thm relInvImage_mono}, rtac subset_trans, etac incl_lsbis,
|
blanchet@49305
|
1091 |
rtac ord_eq_le_trans, rtac @{thm sym[OF relImage_relInvImage]},
|
blanchet@48975
|
1092 |
rtac @{thm xt1(3)}, rtac @{thm Sigma_cong},
|
blanchet@48975
|
1093 |
rtac @{thm proj_image}, rtac @{thm proj_image}, rtac lsbis_incl,
|
blanchet@48975
|
1094 |
rtac subset_trans, rtac @{thm relImage_mono}, rtac incl_lsbis, atac,
|
blanchet@48975
|
1095 |
rtac @{thm relImage_proj}, rtac equiv_LSBIS, rtac @{thm relInvImage_diag},
|
blanchet@48975
|
1096 |
rtac Rep_inject])
|
blanchet@48975
|
1097 |
(Rep_injects ~~ (equiv_LSBISs ~~ (incl_lsbiss ~~ lsbis_incls)))] 1
|
blanchet@48975
|
1098 |
end;
|
blanchet@48975
|
1099 |
|
blanchet@48975
|
1100 |
fun mk_unique_mor_tac raw_coinds bis =
|
blanchet@48975
|
1101 |
CONJ_WRAP' (fn raw_coind =>
|
blanchet@49305
|
1102 |
EVERY' [rtac impI, rtac (bis RS raw_coind RS set_mp RS @{thm IdD}), atac,
|
blanchet@48975
|
1103 |
etac conjunct1, atac, etac conjunct2, rtac @{thm image2_eqI}, rtac refl, rtac refl, atac])
|
blanchet@48975
|
1104 |
raw_coinds 1;
|
blanchet@48975
|
1105 |
|
blanchet@49504
|
1106 |
fun mk_unfold_unique_mor_tac raw_coinds bis mor unfold_defs =
|
blanchet@49504
|
1107 |
CONJ_WRAP' (fn (raw_coind, unfold_def) =>
|
blanchet@49305
|
1108 |
EVERY' [rtac ext, etac (bis RS raw_coind RS set_mp RS @{thm IdD}), rtac mor,
|
blanchet@49504
|
1109 |
rtac @{thm image2_eqI}, rtac refl, rtac (unfold_def RS arg_cong RS trans),
|
blanchet@49504
|
1110 |
rtac (o_apply RS sym), rtac UNIV_I]) (raw_coinds ~~ unfold_defs) 1;
|
blanchet@48975
|
1111 |
|
blanchet@49504
|
1112 |
fun mk_dtor_o_ctor_tac ctor_def unfold map_comp_id map_congL unfold_o_dtors
|
blanchet@48975
|
1113 |
{context = ctxt, prems = _} =
|
blanchet@49504
|
1114 |
unfold_thms_tac ctxt [ctor_def] THEN EVERY' [rtac ext, rtac trans, rtac o_apply,
|
blanchet@49504
|
1115 |
rtac trans, rtac unfold, rtac trans, rtac map_comp_id, rtac trans, rtac map_congL,
|
blanchet@48975
|
1116 |
EVERY' (map (fn thm =>
|
blanchet@49504
|
1117 |
rtac ballI THEN' rtac (trans OF [thm RS fun_cong, @{thm id_apply}])) unfold_o_dtors),
|
blanchet@48975
|
1118 |
rtac sym, rtac @{thm id_apply}] 1;
|
blanchet@48975
|
1119 |
|
blanchet@49504
|
1120 |
fun mk_corec_tac m corec_defs unfold map_cong corec_Inls {context = ctxt, prems = _} =
|
blanchet@49504
|
1121 |
unfold_thms_tac ctxt corec_defs THEN EVERY' [rtac trans, rtac (o_apply RS arg_cong),
|
blanchet@49504
|
1122 |
rtac trans, rtac unfold, fo_rtac (@{thm sum.cases(2)} RS arg_cong RS trans) ctxt, rtac map_cong,
|
blanchet@48975
|
1123 |
REPEAT_DETERM_N m o rtac refl,
|
blanchet@48975
|
1124 |
EVERY' (map (fn thm => rtac @{thm sum_case_expand_Inr} THEN' rtac thm) corec_Inls)] 1;
|
blanchet@48975
|
1125 |
|
blanchet@49506
|
1126 |
fun mk_srel_coinduct_tac ks raw_coind bis_srel =
|
blanchet@49506
|
1127 |
EVERY' [rtac rev_mp, rtac raw_coind, rtac ssubst, rtac bis_srel, rtac conjI,
|
blanchet@48975
|
1128 |
CONJ_WRAP' (K (rtac @{thm ord_le_eq_trans[OF subset_UNIV UNIV_Times_UNIV[THEN sym]]})) ks,
|
blanchet@48975
|
1129 |
CONJ_WRAP' (K (EVERY' [rtac allI, rtac allI, rtac impI,
|
blanchet@48975
|
1130 |
REPEAT_DETERM o etac allE, etac mp, etac CollectE, etac @{thm splitD}])) ks,
|
blanchet@48975
|
1131 |
rtac impI, REPEAT_DETERM o etac conjE,
|
blanchet@49305
|
1132 |
CONJ_WRAP' (K (EVERY' [rtac impI, rtac @{thm IdD}, etac set_mp,
|
blanchet@48975
|
1133 |
rtac CollectI, etac @{thm prod_caseI}])) ks] 1;
|
blanchet@48975
|
1134 |
|
blanchet@49506
|
1135 |
fun mk_srel_strong_coinduct_tac m cTs cts srel_coinduct srel_monos srel_Ids =
|
blanchet@49506
|
1136 |
EVERY' [rtac rev_mp, rtac (Drule.instantiate' cTs cts srel_coinduct),
|
blanchet@49506
|
1137 |
EVERY' (map2 (fn srel_mono => fn srel_Id =>
|
blanchet@48975
|
1138 |
EVERY' [REPEAT_DETERM o resolve_tac [allI, impI], REPEAT_DETERM o etac allE,
|
blanchet@49506
|
1139 |
etac disjE, etac mp, atac, hyp_subst_tac, rtac (srel_mono RS set_mp),
|
blanchet@48975
|
1140 |
REPEAT_DETERM_N m o rtac @{thm subset_refl},
|
blanchet@49506
|
1141 |
REPEAT_DETERM_N (length srel_monos) o rtac @{thm Id_subset},
|
blanchet@49506
|
1142 |
rtac (srel_Id RS equalityD2 RS set_mp), rtac @{thm IdI}])
|
blanchet@49506
|
1143 |
srel_monos srel_Ids),
|
blanchet@48975
|
1144 |
rtac impI, REPEAT_DETERM o etac conjE,
|
blanchet@49506
|
1145 |
CONJ_WRAP' (K (rtac impI THEN' etac mp THEN' etac disjI1)) srel_Ids] 1;
|
blanchet@48975
|
1146 |
|
blanchet@49501
|
1147 |
fun mk_dtor_coinduct_tac m ks raw_coind bis_def =
|
blanchet@48975
|
1148 |
let
|
blanchet@48975
|
1149 |
val n = length ks;
|
blanchet@48975
|
1150 |
in
|
blanchet@48975
|
1151 |
EVERY' [rtac rev_mp, rtac raw_coind, rtac ssubst, rtac bis_def, rtac conjI,
|
blanchet@48975
|
1152 |
CONJ_WRAP' (K (rtac @{thm ord_le_eq_trans[OF subset_UNIV UNIV_Times_UNIV[THEN sym]]})) ks,
|
blanchet@48975
|
1153 |
CONJ_WRAP' (fn i => EVERY' [select_prem_tac n (dtac asm_rl) i, REPEAT_DETERM o rtac allI,
|
blanchet@48975
|
1154 |
rtac impI, REPEAT_DETERM o dtac @{thm meta_spec}, etac CollectE, etac @{thm meta_impE},
|
blanchet@48975
|
1155 |
atac, etac exE, etac conjE, etac conjE, rtac bexI, rtac conjI,
|
blanchet@48975
|
1156 |
etac @{thm fst_conv[THEN subst]}, etac @{thm snd_conv[THEN subst]},
|
traytel@49490
|
1157 |
rtac CollectI, REPEAT_DETERM_N m o (rtac conjI THEN' rtac subset_UNIV),
|
blanchet@48975
|
1158 |
CONJ_WRAP' (fn i' => EVERY' [rtac subsetI, rtac CollectI, dtac (mk_conjunctN n i'),
|
blanchet@48975
|
1159 |
REPEAT_DETERM o etac allE, etac mp, rtac @{thm ssubst_mem[OF pair_collapse]}, atac])
|
blanchet@48975
|
1160 |
ks])
|
blanchet@48975
|
1161 |
ks,
|
blanchet@48975
|
1162 |
rtac impI,
|
blanchet@48975
|
1163 |
CONJ_WRAP' (fn i => EVERY' [rtac impI, dtac (mk_conjunctN n i),
|
blanchet@49305
|
1164 |
rtac @{thm subst[OF pair_in_Id_conv]}, etac set_mp,
|
blanchet@48975
|
1165 |
rtac CollectI, etac (refl RSN (2, @{thm subst_Pair}))]) ks] 1
|
blanchet@48975
|
1166 |
end;
|
blanchet@48975
|
1167 |
|
blanchet@49501
|
1168 |
fun mk_dtor_strong_coinduct_tac ks cTs cts dtor_coinduct bis_def bis_diag =
|
blanchet@49501
|
1169 |
EVERY' [rtac rev_mp, rtac (Drule.instantiate' cTs cts dtor_coinduct),
|
blanchet@48975
|
1170 |
EVERY' (map (fn i =>
|
blanchet@48975
|
1171 |
EVERY' [etac disjE, REPEAT_DETERM o dtac @{thm meta_spec}, etac @{thm meta_mp},
|
blanchet@48975
|
1172 |
atac, rtac rev_mp, rtac subst, rtac bis_def, rtac bis_diag,
|
blanchet@48975
|
1173 |
rtac impI, dtac conjunct2, dtac (mk_conjunctN (length ks) i), REPEAT_DETERM o etac allE,
|
blanchet@48975
|
1174 |
etac impE, etac @{thm diag_UNIV_I}, REPEAT_DETERM o eresolve_tac [bexE, conjE, CollectE],
|
blanchet@48975
|
1175 |
rtac exI, rtac conjI, etac conjI, atac,
|
blanchet@48975
|
1176 |
CONJ_WRAP' (K (EVERY' [REPEAT_DETERM o resolve_tac [allI, impI],
|
blanchet@49305
|
1177 |
rtac disjI2, rtac @{thm diagE}, etac set_mp, atac])) ks])
|
blanchet@48975
|
1178 |
ks),
|
blanchet@48975
|
1179 |
rtac impI, REPEAT_DETERM o etac conjE,
|
blanchet@48975
|
1180 |
CONJ_WRAP' (K (rtac impI THEN' etac mp THEN' etac disjI1)) ks] 1;
|
blanchet@48975
|
1181 |
|
blanchet@49504
|
1182 |
fun mk_map_tac m n cT unfold map_comp' map_cong =
|
blanchet@48975
|
1183 |
EVERY' [rtac ext, rtac (o_apply RS trans RS sym), rtac (o_apply RS trans RS sym),
|
blanchet@49504
|
1184 |
rtac (unfold RS trans), rtac (Thm.permute_prems 0 1 (map_comp' RS box_equals)), rtac map_cong,
|
blanchet@48975
|
1185 |
REPEAT_DETERM_N m o rtac (@{thm id_o} RS fun_cong),
|
blanchet@48975
|
1186 |
REPEAT_DETERM_N n o rtac (@{thm o_id} RS fun_cong),
|
blanchet@48975
|
1187 |
rtac (o_apply RS (Drule.instantiate' [cT] [] arg_cong) RS sym)] 1;
|
blanchet@48975
|
1188 |
|
blanchet@48975
|
1189 |
fun mk_set_le_tac n hset_minimal set_hsets set_hset_hsetss =
|
blanchet@48975
|
1190 |
EVERY' [rtac hset_minimal,
|
blanchet@48975
|
1191 |
REPEAT_DETERM_N n o rtac @{thm Un_upper1},
|
blanchet@48975
|
1192 |
REPEAT_DETERM_N n o
|
blanchet@48975
|
1193 |
EVERY' (map3 (fn i => fn set_hset => fn set_hset_hsets =>
|
blanchet@49366
|
1194 |
EVERY' [rtac subsetI, rtac @{thm UnI2}, rtac (mk_UnIN n i), etac @{thm UN_I},
|
blanchet@48975
|
1195 |
etac UnE, etac set_hset, REPEAT_DETERM_N (n - 1) o etac UnE,
|
blanchet@48975
|
1196 |
EVERY' (map (fn thm => EVERY' [etac @{thm UN_E}, etac thm, atac]) set_hset_hsets)])
|
blanchet@48975
|
1197 |
(1 upto n) set_hsets set_hset_hsetss)] 1;
|
blanchet@48975
|
1198 |
|
blanchet@48975
|
1199 |
fun mk_set_simp_tac n set_le set_incl_hset set_hset_incl_hsets =
|
blanchet@48975
|
1200 |
EVERY' [rtac equalityI, rtac set_le, rtac @{thm Un_least}, rtac set_incl_hset,
|
blanchet@48975
|
1201 |
REPEAT_DETERM_N (n - 1) o rtac @{thm Un_least},
|
blanchet@48975
|
1202 |
EVERY' (map (fn thm => rtac @{thm UN_least} THEN' etac thm) set_hset_incl_hsets)] 1;
|
blanchet@48975
|
1203 |
|
blanchet@49504
|
1204 |
fun mk_map_id_tac maps unfold_unique unfold_dtor =
|
blanchet@49504
|
1205 |
EVERY' [rtac (unfold_unique RS trans), EVERY' (map (fn thm => rtac (thm RS sym)) maps),
|
blanchet@49504
|
1206 |
rtac unfold_dtor] 1;
|
blanchet@48975
|
1207 |
|
blanchet@49504
|
1208 |
fun mk_map_comp_tac m n maps map_comps map_congs unfold_unique =
|
blanchet@49504
|
1209 |
EVERY' [rtac unfold_unique,
|
blanchet@48975
|
1210 |
EVERY' (map3 (fn map_thm => fn map_comp => fn map_cong =>
|
blanchet@48975
|
1211 |
EVERY' (map rtac
|
blanchet@48975
|
1212 |
([@{thm o_assoc} RS trans,
|
blanchet@48975
|
1213 |
@{thm arg_cong2[of _ _ _ _ "op o"]} OF [map_comp RS sym, refl] RS trans,
|
blanchet@48975
|
1214 |
@{thm o_assoc} RS trans RS sym,
|
blanchet@48975
|
1215 |
@{thm arg_cong2[of _ _ _ _ "op o"]} OF [map_thm, refl] RS trans,
|
blanchet@48975
|
1216 |
@{thm o_assoc} RS sym RS trans, map_thm RS arg_cong RS trans, @{thm o_assoc} RS trans,
|
blanchet@48975
|
1217 |
@{thm arg_cong2[of _ _ _ _ "op o"]} OF [map_comp RS sym, refl] RS trans,
|
blanchet@48975
|
1218 |
ext, o_apply RS trans, o_apply RS trans RS sym, map_cong] @
|
blanchet@48975
|
1219 |
replicate m (@{thm id_o} RS fun_cong) @
|
blanchet@48975
|
1220 |
replicate n (@{thm o_id} RS fun_cong))))
|
blanchet@48975
|
1221 |
maps map_comps map_congs)] 1;
|
blanchet@48975
|
1222 |
|
blanchet@48975
|
1223 |
fun mk_mcong_tac m coinduct_tac map_comp's map_simps map_congs set_naturalss set_hsetss
|
blanchet@48975
|
1224 |
set_hset_hsetsss =
|
blanchet@48975
|
1225 |
let
|
blanchet@48975
|
1226 |
val n = length map_comp's;
|
blanchet@48975
|
1227 |
val ks = 1 upto n;
|
blanchet@48975
|
1228 |
in
|
blanchet@48975
|
1229 |
EVERY' ([rtac rev_mp,
|
blanchet@48975
|
1230 |
coinduct_tac] @
|
blanchet@48975
|
1231 |
maps (fn (((((map_comp'_trans, map_simps_trans), map_cong), set_naturals), set_hsets),
|
blanchet@48975
|
1232 |
set_hset_hsetss) =>
|
blanchet@48975
|
1233 |
[REPEAT_DETERM o eresolve_tac [exE, conjE], hyp_subst_tac, rtac exI, rtac conjI, rtac conjI,
|
blanchet@48975
|
1234 |
rtac map_comp'_trans, rtac sym, rtac map_simps_trans, rtac map_cong,
|
blanchet@48975
|
1235 |
REPEAT_DETERM_N m o (rtac o_apply_trans_sym THEN' rtac @{thm id_apply}),
|
blanchet@48975
|
1236 |
REPEAT_DETERM_N n o rtac fst_convol_fun_cong_sym,
|
blanchet@48975
|
1237 |
rtac map_comp'_trans, rtac sym, rtac map_simps_trans, rtac map_cong,
|
blanchet@48975
|
1238 |
EVERY' (maps (fn set_hset =>
|
blanchet@48975
|
1239 |
[rtac o_apply_trans_sym, rtac (@{thm id_apply} RS trans), etac CollectE,
|
blanchet@48975
|
1240 |
REPEAT_DETERM o etac conjE, etac bspec, etac set_hset]) set_hsets),
|
blanchet@48975
|
1241 |
REPEAT_DETERM_N n o rtac snd_convol_fun_cong_sym,
|
blanchet@48975
|
1242 |
CONJ_WRAP' (fn (set_natural, set_hset_hsets) =>
|
blanchet@48975
|
1243 |
EVERY' [REPEAT_DETERM o rtac allI, rtac impI, rtac @{thm image_convolD},
|
blanchet@49305
|
1244 |
etac set_rev_mp, rtac ord_eq_le_trans, rtac set_natural,
|
blanchet@48975
|
1245 |
rtac @{thm image_mono}, rtac subsetI, rtac CollectI, etac CollectE,
|
blanchet@48975
|
1246 |
REPEAT_DETERM o etac conjE,
|
blanchet@48975
|
1247 |
CONJ_WRAP' (fn set_hset_hset =>
|
blanchet@48975
|
1248 |
EVERY' [rtac ballI, etac bspec, etac set_hset_hset, atac]) set_hset_hsets])
|
blanchet@48975
|
1249 |
(drop m set_naturals ~~ set_hset_hsetss)])
|
blanchet@48975
|
1250 |
(map (fn th => th RS trans) map_comp's ~~ map (fn th => th RS trans) map_simps ~~
|
blanchet@48975
|
1251 |
map_congs ~~ set_naturalss ~~ set_hsetss ~~ set_hset_hsetsss) @
|
blanchet@48975
|
1252 |
[rtac impI,
|
blanchet@48975
|
1253 |
CONJ_WRAP' (fn k =>
|
blanchet@48975
|
1254 |
EVERY' [rtac impI, dtac (mk_conjunctN n k), etac mp, rtac exI, rtac conjI, etac CollectI,
|
blanchet@48975
|
1255 |
rtac conjI, rtac refl, rtac refl]) ks]) 1
|
blanchet@48975
|
1256 |
end
|
blanchet@48975
|
1257 |
|
blanchet@49504
|
1258 |
fun mk_map_unique_tac unfold_unique map_comps {context = ctxt, prems = _} =
|
blanchet@49504
|
1259 |
rtac unfold_unique 1 THEN
|
blanchet@49504
|
1260 |
unfold_thms_tac ctxt (map (fn thm => thm RS sym) map_comps @ @{thms o_assoc id_o o_id}) THEN
|
blanchet@48975
|
1261 |
ALLGOALS (etac sym);
|
blanchet@48975
|
1262 |
|
blanchet@48975
|
1263 |
fun mk_col_natural_tac cts rec_0s rec_Sucs map_simps set_naturalss
|
blanchet@48975
|
1264 |
{context = ctxt, prems = _} =
|
blanchet@48975
|
1265 |
let
|
blanchet@48975
|
1266 |
val n = length map_simps;
|
blanchet@48975
|
1267 |
in
|
blanchet@49305
|
1268 |
EVERY' [rtac (Drule.instantiate' [] cts nat_induct),
|
blanchet@49504
|
1269 |
REPEAT_DETERM o rtac allI, SELECT_GOAL (unfold_thms_tac ctxt rec_0s),
|
blanchet@48975
|
1270 |
CONJ_WRAP' (K (rtac @{thm image_empty})) rec_0s,
|
blanchet@48975
|
1271 |
REPEAT_DETERM o rtac allI,
|
blanchet@48975
|
1272 |
CONJ_WRAP' (fn (rec_Suc, (map_simp, set_nats)) => EVERY'
|
blanchet@49504
|
1273 |
[SELECT_GOAL (unfold_thms_tac ctxt
|
blanchet@48975
|
1274 |
(rec_Suc :: map_simp :: set_nats @ @{thms image_Un image_UN UN_simps(10)})),
|
blanchet@48975
|
1275 |
rtac @{thm Un_cong}, rtac refl,
|
blanchet@48975
|
1276 |
CONJ_WRAP_GEN' (rtac (Thm.permute_prems 0 1 @{thm Un_cong}))
|
blanchet@48975
|
1277 |
(fn i => EVERY' [rtac @{thm UN_cong[OF refl]},
|
blanchet@48975
|
1278 |
REPEAT_DETERM o etac allE, etac (mk_conjunctN n i)]) (n downto 1)])
|
blanchet@48975
|
1279 |
(rec_Sucs ~~ (map_simps ~~ set_naturalss))] 1
|
blanchet@48975
|
1280 |
end;
|
blanchet@48975
|
1281 |
|
blanchet@48975
|
1282 |
fun mk_set_natural_tac hset_def col_natural =
|
blanchet@48975
|
1283 |
EVERY' (map rtac [ext, (o_apply RS trans), (hset_def RS trans), sym,
|
blanchet@48975
|
1284 |
(o_apply RS trans), (@{thm image_cong} OF [hset_def, refl] RS trans),
|
blanchet@48975
|
1285 |
(@{thm image_UN} RS trans), (refl RS @{thm UN_cong}), col_natural]) 1;
|
blanchet@48975
|
1286 |
|
blanchet@48975
|
1287 |
fun mk_col_bd_tac m j cts rec_0s rec_Sucs sbd_Card_order sbd_Cinfinite set_sbdss =
|
blanchet@48975
|
1288 |
let
|
blanchet@48975
|
1289 |
val n = length rec_0s;
|
blanchet@48975
|
1290 |
in
|
blanchet@49305
|
1291 |
EVERY' [rtac (Drule.instantiate' [] cts nat_induct),
|
blanchet@48975
|
1292 |
REPEAT_DETERM o rtac allI,
|
blanchet@49305
|
1293 |
CONJ_WRAP' (fn rec_0 => EVERY' (map rtac [ordIso_ordLeq_trans,
|
blanchet@48975
|
1294 |
@{thm card_of_ordIso_subst}, rec_0, @{thm Card_order_empty}, sbd_Card_order])) rec_0s,
|
blanchet@48975
|
1295 |
REPEAT_DETERM o rtac allI,
|
blanchet@48975
|
1296 |
CONJ_WRAP' (fn (rec_Suc, set_sbds) => EVERY'
|
blanchet@49305
|
1297 |
[rtac ordIso_ordLeq_trans, rtac @{thm card_of_ordIso_subst}, rtac rec_Suc,
|
blanchet@48975
|
1298 |
rtac (sbd_Cinfinite RSN (3, @{thm Un_Cinfinite_bound})), rtac (nth set_sbds (j - 1)),
|
blanchet@48975
|
1299 |
REPEAT_DETERM_N (n - 1) o rtac (sbd_Cinfinite RSN (3, @{thm Un_Cinfinite_bound})),
|
blanchet@48975
|
1300 |
EVERY' (map2 (fn i => fn set_sbd => EVERY' [rtac @{thm UNION_Cinfinite_bound},
|
blanchet@48975
|
1301 |
rtac set_sbd, rtac ballI, REPEAT_DETERM o etac allE,
|
blanchet@48975
|
1302 |
etac (mk_conjunctN n i), rtac sbd_Cinfinite]) (1 upto n) (drop m set_sbds))])
|
blanchet@48975
|
1303 |
(rec_Sucs ~~ set_sbdss)] 1
|
blanchet@48975
|
1304 |
end;
|
blanchet@48975
|
1305 |
|
blanchet@48975
|
1306 |
fun mk_set_bd_tac sbd_Cinfinite hset_def col_bd =
|
blanchet@49305
|
1307 |
EVERY' (map rtac [ordIso_ordLeq_trans, @{thm card_of_ordIso_subst}, hset_def,
|
blanchet@49305
|
1308 |
ctrans, @{thm UNION_Cinfinite_bound}, ordIso_ordLeq_trans, @{thm card_of_nat},
|
blanchet@48975
|
1309 |
@{thm natLeq_ordLeq_cinfinite}, sbd_Cinfinite, ballI, col_bd, sbd_Cinfinite,
|
blanchet@48975
|
1310 |
ctrans, @{thm infinite_ordLeq_cexp}, sbd_Cinfinite, @{thm cexp_ordLeq_ccexp}]) 1;
|
blanchet@48975
|
1311 |
|
blanchet@48975
|
1312 |
fun mk_in_bd_tac isNode_hset isNode_hsets carT_def card_of_carT mor_image Rep_inverse mor_hsets
|
blanchet@48975
|
1313 |
sbd_Cnotzero sbd_Card_order mor_Rep coalgT mor_T_final tcoalg =
|
blanchet@48975
|
1314 |
let
|
blanchet@48975
|
1315 |
val n = length isNode_hsets;
|
blanchet@48975
|
1316 |
val in_hin_tac = rtac CollectI THEN'
|
blanchet@48975
|
1317 |
CONJ_WRAP' (fn mor_hset => EVERY' (map etac
|
blanchet@49305
|
1318 |
[mor_hset OF [coalgT, mor_T_final] RS sym RS ord_eq_le_trans,
|
blanchet@49305
|
1319 |
arg_cong RS sym RS ord_eq_le_trans,
|
blanchet@49305
|
1320 |
mor_hset OF [tcoalg, mor_Rep, UNIV_I] RS ord_eq_le_trans])) mor_hsets;
|
blanchet@48975
|
1321 |
in
|
blanchet@48975
|
1322 |
EVERY' [rtac (Thm.permute_prems 0 1 @{thm ordLeq_transitive}), rtac ctrans,
|
blanchet@49305
|
1323 |
rtac @{thm card_of_image}, rtac ordIso_ordLeq_trans,
|
blanchet@48975
|
1324 |
rtac @{thm card_of_ordIso_subst}, rtac @{thm sym[OF proj_image]}, rtac ctrans,
|
blanchet@48975
|
1325 |
rtac @{thm card_of_image}, rtac ctrans, rtac card_of_carT, rtac @{thm cexp_mono2_Cnotzero},
|
blanchet@48975
|
1326 |
rtac @{thm cexp_ordLeq_ccexp}, rtac @{thm csum_Cnotzero2}, rtac @{thm ctwo_Cnotzero},
|
blanchet@48975
|
1327 |
rtac @{thm Cnotzero_cexp}, rtac sbd_Cnotzero, rtac sbd_Card_order,
|
blanchet@48975
|
1328 |
rtac @{thm card_of_mono1}, rtac subsetI, rtac @{thm image_eqI}, rtac sym,
|
blanchet@48975
|
1329 |
rtac Rep_inverse, REPEAT_DETERM o eresolve_tac [CollectE, conjE],
|
blanchet@49305
|
1330 |
rtac set_mp, rtac equalityD2, rtac @{thm sym[OF proj_image]}, rtac imageE,
|
blanchet@49305
|
1331 |
rtac set_rev_mp, rtac mor_image, rtac mor_Rep, rtac UNIV_I, rtac equalityD2,
|
blanchet@48975
|
1332 |
rtac @{thm proj_image}, rtac @{thm image_eqI}, atac,
|
blanchet@49305
|
1333 |
ftac (carT_def RS equalityD1 RS set_mp),
|
blanchet@48975
|
1334 |
REPEAT_DETERM o eresolve_tac [CollectE, exE, conjE], hyp_subst_tac,
|
blanchet@49305
|
1335 |
rtac (carT_def RS equalityD2 RS set_mp), rtac CollectI, REPEAT_DETERM o rtac exI,
|
blanchet@48975
|
1336 |
rtac conjI, rtac refl, rtac conjI, etac conjI, etac conjI, etac conjI, rtac conjI,
|
blanchet@48975
|
1337 |
rtac ballI, dtac bspec, atac, REPEAT_DETERM o etac conjE, rtac conjI,
|
blanchet@48975
|
1338 |
CONJ_WRAP_GEN' (etac disjE) (fn (i, isNode_hset) =>
|
blanchet@48975
|
1339 |
EVERY' [rtac (mk_disjIN n i), rtac isNode_hset, atac, atac, atac, in_hin_tac])
|
blanchet@48975
|
1340 |
(1 upto n ~~ isNode_hsets),
|
blanchet@48975
|
1341 |
CONJ_WRAP' (fn isNode_hset =>
|
blanchet@48975
|
1342 |
EVERY' [rtac ballI, rtac isNode_hset, atac, ftac CollectD, etac @{thm SuccD},
|
blanchet@48975
|
1343 |
etac bspec, atac, in_hin_tac])
|
blanchet@48975
|
1344 |
isNode_hsets,
|
blanchet@48975
|
1345 |
atac, rtac isNode_hset, atac, atac, atac, in_hin_tac] 1
|
blanchet@48975
|
1346 |
end;
|
blanchet@48975
|
1347 |
|
blanchet@48975
|
1348 |
fun mk_bd_card_order_tac sbd_card_order =
|
blanchet@48975
|
1349 |
EVERY' (map rtac [@{thm card_order_ccexp}, sbd_card_order, sbd_card_order]) 1;
|
blanchet@48975
|
1350 |
|
blanchet@48975
|
1351 |
fun mk_bd_cinfinite_tac sbd_Cinfinite =
|
blanchet@48975
|
1352 |
EVERY' (map rtac [@{thm cinfinite_ccexp}, @{thm ctwo_ordLeq_Cinfinite},
|
blanchet@48975
|
1353 |
sbd_Cinfinite, sbd_Cinfinite]) 1;
|
blanchet@48975
|
1354 |
|
blanchet@48975
|
1355 |
fun mk_pickWP_assms_tac set_incl_hsets set_incl_hins map_eq =
|
blanchet@48975
|
1356 |
let
|
blanchet@48975
|
1357 |
val m = length set_incl_hsets;
|
blanchet@48975
|
1358 |
in
|
blanchet@48975
|
1359 |
EVERY' [REPEAT_DETERM o eresolve_tac [CollectE, conjE], rtac CollectI,
|
blanchet@48975
|
1360 |
EVERY' (map (fn thm => rtac conjI THEN' etac (thm RS @{thm subset_trans})) set_incl_hsets),
|
blanchet@48975
|
1361 |
CONJ_WRAP' (fn thm => rtac thm THEN' REPEAT_DETERM_N m o atac) set_incl_hins,
|
blanchet@48975
|
1362 |
REPEAT_DETERM o eresolve_tac [CollectE, conjE], rtac CollectI,
|
blanchet@48975
|
1363 |
EVERY' (map (fn thm => rtac conjI THEN' etac (thm RS @{thm subset_trans})) set_incl_hsets),
|
blanchet@48975
|
1364 |
CONJ_WRAP' (fn thm => rtac thm THEN' REPEAT_DETERM_N m o atac) set_incl_hins,
|
blanchet@48975
|
1365 |
REPEAT_DETERM o eresolve_tac [CollectE, conjE], etac map_eq]
|
blanchet@48975
|
1366 |
end;
|
blanchet@48975
|
1367 |
|
blanchet@48975
|
1368 |
fun mk_coalg_thePull_tac m coalg_def map_wpulls set_naturalss pickWP_assms_tacs
|
blanchet@48975
|
1369 |
{context = ctxt, prems = _} =
|
blanchet@49504
|
1370 |
unfold_thms_tac ctxt [coalg_def] THEN
|
blanchet@48975
|
1371 |
CONJ_WRAP' (fn (map_wpull, (pickWP_assms_tac, set_naturals)) =>
|
blanchet@48975
|
1372 |
EVERY' [rtac ballI, dtac @{thm set_mp[OF equalityD1[OF thePull_def]]},
|
blanchet@48975
|
1373 |
REPEAT_DETERM o eresolve_tac [CollectE, @{thm prod_caseE}],
|
blanchet@48975
|
1374 |
hyp_subst_tac, rtac rev_mp, rtac (map_wpull RS @{thm pickWP(1)}),
|
blanchet@48975
|
1375 |
EVERY' (map (etac o mk_conjunctN m) (1 upto m)),
|
blanchet@48975
|
1376 |
pickWP_assms_tac,
|
blanchet@49504
|
1377 |
SELECT_GOAL (unfold_thms_tac ctxt @{thms o_apply prod.cases}), rtac impI,
|
blanchet@48975
|
1378 |
REPEAT_DETERM o eresolve_tac [CollectE, conjE],
|
blanchet@48975
|
1379 |
rtac CollectI,
|
traytel@49490
|
1380 |
REPEAT_DETERM_N m o (rtac conjI THEN' rtac subset_UNIV),
|
blanchet@48975
|
1381 |
CONJ_WRAP' (fn set_natural =>
|
blanchet@49305
|
1382 |
EVERY' [rtac ord_eq_le_trans, rtac trans, rtac set_natural,
|
blanchet@49305
|
1383 |
rtac trans_fun_cong_image_id_id_apply, atac])
|
blanchet@48975
|
1384 |
(drop m set_naturals)])
|
blanchet@48975
|
1385 |
(map_wpulls ~~ (pickWP_assms_tacs ~~ set_naturalss)) 1;
|
blanchet@48975
|
1386 |
|
blanchet@48975
|
1387 |
fun mk_mor_thePull_nth_tac conv pick m mor_def map_wpulls map_comps pickWP_assms_tacs
|
blanchet@48975
|
1388 |
{context = ctxt, prems = _} =
|
blanchet@48975
|
1389 |
let
|
blanchet@48975
|
1390 |
val n = length map_comps;
|
blanchet@48975
|
1391 |
in
|
blanchet@49504
|
1392 |
unfold_thms_tac ctxt [mor_def] THEN
|
blanchet@48975
|
1393 |
EVERY' [rtac conjI,
|
blanchet@48975
|
1394 |
CONJ_WRAP' (K (rtac ballI THEN' rtac UNIV_I)) (1 upto n),
|
blanchet@48975
|
1395 |
CONJ_WRAP' (fn (map_wpull, (pickWP_assms_tac, map_comp)) =>
|
blanchet@48975
|
1396 |
EVERY' [rtac ballI, dtac @{thm set_mp[OF equalityD1[OF thePull_def]]},
|
blanchet@48975
|
1397 |
REPEAT_DETERM o eresolve_tac [CollectE, @{thm prod_caseE}, conjE],
|
blanchet@48975
|
1398 |
hyp_subst_tac,
|
blanchet@49504
|
1399 |
SELECT_GOAL (unfold_thms_tac ctxt @{thms o_apply prod.cases}),
|
blanchet@48975
|
1400 |
rtac (map_comp RS trans),
|
blanchet@49504
|
1401 |
SELECT_GOAL (unfold_thms_tac ctxt (conv :: @{thms o_id id_o})),
|
blanchet@48975
|
1402 |
rtac (map_wpull RS pick), REPEAT_DETERM_N m o atac,
|
blanchet@48975
|
1403 |
pickWP_assms_tac])
|
blanchet@48975
|
1404 |
(map_wpulls ~~ (pickWP_assms_tacs ~~ map_comps))] 1
|
blanchet@48975
|
1405 |
end;
|
blanchet@48975
|
1406 |
|
blanchet@48975
|
1407 |
val mk_mor_thePull_fst_tac = mk_mor_thePull_nth_tac @{thm fst_conv} @{thm pickWP(2)};
|
blanchet@48975
|
1408 |
val mk_mor_thePull_snd_tac = mk_mor_thePull_nth_tac @{thm snd_conv} @{thm pickWP(3)};
|
blanchet@48975
|
1409 |
|
blanchet@49504
|
1410 |
fun mk_mor_thePull_pick_tac mor_def unfolds map_comps {context = ctxt, prems = _} =
|
blanchet@49504
|
1411 |
unfold_thms_tac ctxt [mor_def, @{thm thePull_def}] THEN rtac conjI 1 THEN
|
blanchet@49504
|
1412 |
CONJ_WRAP' (K (rtac ballI THEN' rtac UNIV_I)) unfolds 1 THEN
|
blanchet@49504
|
1413 |
CONJ_WRAP' (fn (unfold, map_comp) =>
|
blanchet@48975
|
1414 |
EVERY' [rtac ballI, REPEAT_DETERM o eresolve_tac [CollectE, @{thm prod_caseE}, conjE],
|
blanchet@48975
|
1415 |
hyp_subst_tac,
|
blanchet@49504
|
1416 |
SELECT_GOAL (unfold_thms_tac ctxt (unfold :: map_comp :: @{thms comp_def id_def})),
|
blanchet@48975
|
1417 |
rtac refl])
|
blanchet@49504
|
1418 |
(unfolds ~~ map_comps) 1;
|
blanchet@48975
|
1419 |
|
blanchet@49504
|
1420 |
fun mk_pick_col_tac m j cts rec_0s rec_Sucs unfolds set_naturalss map_wpulls pickWP_assms_tacs
|
blanchet@48975
|
1421 |
{context = ctxt, prems = _} =
|
blanchet@48975
|
1422 |
let
|
blanchet@48975
|
1423 |
val n = length rec_0s;
|
blanchet@48975
|
1424 |
val ks = n downto 1;
|
blanchet@48975
|
1425 |
in
|
blanchet@49305
|
1426 |
EVERY' [rtac (Drule.instantiate' [] cts nat_induct),
|
blanchet@48975
|
1427 |
REPEAT_DETERM o rtac allI,
|
blanchet@48975
|
1428 |
CONJ_WRAP' (fn thm => EVERY'
|
blanchet@49305
|
1429 |
[rtac impI, rtac ord_eq_le_trans, rtac thm, rtac @{thm empty_subsetI}]) rec_0s,
|
blanchet@48975
|
1430 |
REPEAT_DETERM o rtac allI,
|
blanchet@49504
|
1431 |
CONJ_WRAP' (fn (rec_Suc, ((unfold, set_naturals), (map_wpull, pickWP_assms_tac))) =>
|
blanchet@48975
|
1432 |
EVERY' [rtac impI, dtac @{thm set_mp[OF equalityD1[OF thePull_def]]},
|
blanchet@48975
|
1433 |
REPEAT_DETERM o eresolve_tac [CollectE, @{thm prod_caseE}],
|
blanchet@48975
|
1434 |
hyp_subst_tac, rtac rev_mp, rtac (map_wpull RS @{thm pickWP(1)}),
|
blanchet@48975
|
1435 |
EVERY' (map (etac o mk_conjunctN m) (1 upto m)),
|
blanchet@48975
|
1436 |
pickWP_assms_tac,
|
blanchet@48975
|
1437 |
rtac impI, REPEAT_DETERM o eresolve_tac [CollectE, conjE],
|
blanchet@49305
|
1438 |
rtac ord_eq_le_trans, rtac rec_Suc,
|
blanchet@48975
|
1439 |
rtac @{thm Un_least},
|
blanchet@49504
|
1440 |
SELECT_GOAL (unfold_thms_tac ctxt [unfold, nth set_naturals (j - 1),
|
blanchet@48975
|
1441 |
@{thm prod.cases}]),
|
blanchet@49305
|
1442 |
etac ord_eq_le_trans_trans_fun_cong_image_id_id_apply,
|
blanchet@48975
|
1443 |
CONJ_WRAP_GEN' (rtac (Thm.permute_prems 0 1 @{thm Un_least})) (fn (i, set_natural) =>
|
blanchet@48975
|
1444 |
EVERY' [rtac @{thm UN_least},
|
blanchet@49504
|
1445 |
SELECT_GOAL (unfold_thms_tac ctxt [unfold, set_natural, @{thm prod.cases}]),
|
blanchet@48975
|
1446 |
etac imageE, hyp_subst_tac, REPEAT_DETERM o etac allE,
|
blanchet@49305
|
1447 |
dtac (mk_conjunctN n i), etac mp, etac set_mp, atac])
|
blanchet@48975
|
1448 |
(ks ~~ rev (drop m set_naturals))])
|
blanchet@49504
|
1449 |
(rec_Sucs ~~ ((unfolds ~~ set_naturalss) ~~ (map_wpulls ~~ pickWP_assms_tacs)))] 1
|
blanchet@48975
|
1450 |
end;
|
blanchet@48975
|
1451 |
|
blanchet@48975
|
1452 |
fun mk_wpull_tac m coalg_thePull mor_thePull_fst mor_thePull_snd mor_thePull_pick
|
blanchet@48975
|
1453 |
mor_unique pick_cols hset_defs =
|
traytel@49488
|
1454 |
EVERY' [rtac (@{thm wpull_def} RS iffD2), REPEAT_DETERM o rtac allI, rtac impI,
|
blanchet@48975
|
1455 |
REPEAT_DETERM o etac conjE, rtac bexI, rtac conjI,
|
blanchet@48975
|
1456 |
rtac box_equals, rtac mor_unique,
|
blanchet@48975
|
1457 |
rtac coalg_thePull, REPEAT_DETERM_N (m - 1) o etac conjI, atac,
|
blanchet@48975
|
1458 |
rtac mor_thePull_pick, REPEAT_DETERM_N (m - 1) o etac conjI, atac,
|
blanchet@48975
|
1459 |
rtac mor_thePull_fst, REPEAT_DETERM_N (m - 1) o etac conjI, atac,
|
blanchet@48975
|
1460 |
rtac @{thm set_mp[OF equalityD2[OF thePull_def]]}, rtac CollectI,
|
blanchet@48975
|
1461 |
rtac @{thm prod_caseI}, etac conjI, etac conjI, atac, rtac o_apply, rtac @{thm fst_conv},
|
blanchet@48975
|
1462 |
rtac box_equals, rtac mor_unique,
|
blanchet@48975
|
1463 |
rtac coalg_thePull, REPEAT_DETERM_N (m - 1) o etac conjI, atac,
|
blanchet@48975
|
1464 |
rtac mor_thePull_pick, REPEAT_DETERM_N (m - 1) o etac conjI, atac,
|
blanchet@48975
|
1465 |
rtac mor_thePull_snd, REPEAT_DETERM_N (m - 1) o etac conjI, atac,
|
blanchet@48975
|
1466 |
rtac @{thm set_mp[OF equalityD2[OF thePull_def]]}, rtac CollectI,
|
blanchet@48975
|
1467 |
rtac @{thm prod_caseI}, etac conjI, etac conjI, atac, rtac o_apply, rtac @{thm snd_conv},
|
blanchet@48975
|
1468 |
rtac CollectI,
|
blanchet@48975
|
1469 |
CONJ_WRAP' (fn (pick, def) =>
|
blanchet@49305
|
1470 |
EVERY' [rtac (def RS ord_eq_le_trans), rtac @{thm UN_least},
|
blanchet@48975
|
1471 |
rtac pick, REPEAT_DETERM_N (m - 1) o etac conjI, atac,
|
blanchet@48975
|
1472 |
rtac @{thm set_mp[OF equalityD2[OF thePull_def]]}, rtac CollectI,
|
blanchet@48975
|
1473 |
rtac @{thm prod_caseI}, etac conjI, etac conjI, atac])
|
blanchet@48975
|
1474 |
(pick_cols ~~ hset_defs)] 1;
|
blanchet@48975
|
1475 |
|
blanchet@49501
|
1476 |
fun mk_wit_tac n dtor_ctors set_simp wit coind_wits {context = ctxt, prems = _} =
|
traytel@49104
|
1477 |
ALLGOALS (TRY o (eresolve_tac coind_wits THEN' rtac refl)) THEN
|
blanchet@48975
|
1478 |
REPEAT_DETERM (atac 1 ORELSE
|
blanchet@49305
|
1479 |
EVERY' [dtac set_rev_mp, rtac equalityD1, resolve_tac set_simp,
|
blanchet@49504
|
1480 |
K (unfold_thms_tac ctxt dtor_ctors),
|
blanchet@48975
|
1481 |
REPEAT_DETERM_N n o etac UnE,
|
blanchet@48975
|
1482 |
REPEAT_DETERM o
|
blanchet@48975
|
1483 |
(TRY o REPEAT_DETERM o etac UnE THEN' TRY o etac @{thm UN_E} THEN'
|
blanchet@48975
|
1484 |
(eresolve_tac wit ORELSE'
|
blanchet@48975
|
1485 |
(dresolve_tac wit THEN'
|
blanchet@48975
|
1486 |
(etac FalseE ORELSE'
|
blanchet@49305
|
1487 |
EVERY' [hyp_subst_tac, dtac set_rev_mp, rtac equalityD1, resolve_tac set_simp,
|
blanchet@49504
|
1488 |
K (unfold_thms_tac ctxt dtor_ctors), REPEAT_DETERM_N n o etac UnE]))))] 1);
|
blanchet@48975
|
1489 |
|
blanchet@49504
|
1490 |
fun mk_coind_wit_tac induct unfolds set_nats wits {context = ctxt, prems = _} =
|
traytel@49104
|
1491 |
rtac induct 1 THEN ALLGOALS (TRY o rtac impI THEN' TRY o hyp_subst_tac) THEN
|
blanchet@49504
|
1492 |
unfold_thms_tac ctxt (unfolds @ set_nats @ @{thms image_id id_apply}) THEN
|
traytel@49104
|
1493 |
ALLGOALS (REPEAT_DETERM o etac imageE THEN' TRY o hyp_subst_tac) THEN
|
traytel@49104
|
1494 |
ALLGOALS (TRY o
|
traytel@49104
|
1495 |
FIRST' [rtac TrueI, rtac refl, etac (refl RSN (2, mp)), dresolve_tac wits THEN' etac FalseE])
|
traytel@49104
|
1496 |
|
blanchet@49506
|
1497 |
fun mk_srel_simp_tac in_Jsrels i in_srel map_comp map_cong map_simp set_simps dtor_inject dtor_ctor
|
blanchet@48975
|
1498 |
set_naturals set_incls set_set_inclss =
|
blanchet@48975
|
1499 |
let
|
blanchet@48975
|
1500 |
val m = length set_incls;
|
blanchet@48975
|
1501 |
val n = length set_set_inclss;
|
blanchet@48975
|
1502 |
val (passive_set_naturals, active_set_naturals) = chop m set_naturals;
|
blanchet@49506
|
1503 |
val in_Jsrel = nth in_Jsrels (i - 1);
|
blanchet@48975
|
1504 |
val if_tac =
|
blanchet@49506
|
1505 |
EVERY' [dtac (in_Jsrel RS iffD1), REPEAT_DETERM o eresolve_tac [exE, conjE, CollectE],
|
blanchet@49506
|
1506 |
rtac (in_srel RS iffD2), rtac exI, rtac conjI, rtac CollectI,
|
blanchet@48975
|
1507 |
EVERY' (map2 (fn set_natural => fn set_incl =>
|
blanchet@49305
|
1508 |
EVERY' [rtac conjI, rtac ord_eq_le_trans, rtac set_natural,
|
blanchet@49305
|
1509 |
rtac ord_eq_le_trans, rtac trans_fun_cong_image_id_id_apply,
|
blanchet@48975
|
1510 |
etac (set_incl RS @{thm subset_trans})])
|
blanchet@48975
|
1511 |
passive_set_naturals set_incls),
|
blanchet@49506
|
1512 |
CONJ_WRAP' (fn (in_Jsrel, (set_natural, set_set_incls)) =>
|
blanchet@49305
|
1513 |
EVERY' [rtac ord_eq_le_trans, rtac set_natural, rtac @{thm image_subsetI},
|
blanchet@49506
|
1514 |
rtac (in_Jsrel RS iffD2), rtac exI, rtac conjI, rtac CollectI,
|
blanchet@48975
|
1515 |
CONJ_WRAP' (fn thm => etac (thm RS @{thm subset_trans}) THEN' atac) set_set_incls,
|
blanchet@48975
|
1516 |
rtac conjI, rtac refl, rtac refl])
|
blanchet@49506
|
1517 |
(in_Jsrels ~~ (active_set_naturals ~~ set_set_inclss)),
|
blanchet@48975
|
1518 |
CONJ_WRAP' (fn conv =>
|
blanchet@48975
|
1519 |
EVERY' [rtac trans, rtac map_comp, rtac trans, rtac map_cong,
|
blanchet@48975
|
1520 |
REPEAT_DETERM_N m o rtac @{thm fun_cong[OF o_id]},
|
blanchet@48975
|
1521 |
REPEAT_DETERM_N n o EVERY' (map rtac [trans, o_apply, conv]),
|
blanchet@49501
|
1522 |
rtac trans, rtac sym, rtac map_simp, rtac (dtor_inject RS iffD2), atac])
|
blanchet@48975
|
1523 |
@{thms fst_conv snd_conv}];
|
blanchet@48975
|
1524 |
val only_if_tac =
|
blanchet@49506
|
1525 |
EVERY' [dtac (in_srel RS iffD1), REPEAT_DETERM o eresolve_tac [exE, conjE, CollectE],
|
blanchet@49506
|
1526 |
rtac (in_Jsrel RS iffD2), rtac exI, rtac conjI, rtac CollectI,
|
blanchet@48975
|
1527 |
CONJ_WRAP' (fn (set_simp, passive_set_natural) =>
|
blanchet@49305
|
1528 |
EVERY' [rtac ord_eq_le_trans, rtac set_simp, rtac @{thm Un_least},
|
blanchet@49305
|
1529 |
rtac ord_eq_le_trans, rtac box_equals, rtac passive_set_natural,
|
blanchet@49501
|
1530 |
rtac (dtor_ctor RS sym RS arg_cong), rtac trans_fun_cong_image_id_id_apply, atac,
|
blanchet@48975
|
1531 |
CONJ_WRAP_GEN' (rtac (Thm.permute_prems 0 1 @{thm Un_least}))
|
blanchet@49506
|
1532 |
(fn (active_set_natural, in_Jsrel) => EVERY' [rtac ord_eq_le_trans,
|
blanchet@48975
|
1533 |
rtac @{thm UN_cong[OF _ refl]}, rtac @{thm box_equals[OF _ _ refl]},
|
blanchet@49501
|
1534 |
rtac active_set_natural, rtac (dtor_ctor RS sym RS arg_cong), rtac @{thm UN_least},
|
blanchet@49305
|
1535 |
dtac set_rev_mp, etac @{thm image_mono}, etac imageE,
|
blanchet@49506
|
1536 |
dtac @{thm ssubst_mem[OF pair_collapse]}, dtac (in_Jsrel RS iffD1),
|
blanchet@48975
|
1537 |
dtac @{thm someI_ex}, REPEAT_DETERM o etac conjE,
|
blanchet@48975
|
1538 |
dtac (Thm.permute_prems 0 1 @{thm ssubst_mem}), atac,
|
blanchet@48975
|
1539 |
hyp_subst_tac, REPEAT_DETERM o eresolve_tac [CollectE, conjE], atac])
|
blanchet@49506
|
1540 |
(rev (active_set_naturals ~~ in_Jsrels))])
|
blanchet@48975
|
1541 |
(set_simps ~~ passive_set_naturals),
|
blanchet@48975
|
1542 |
rtac conjI,
|
blanchet@49501
|
1543 |
REPEAT_DETERM_N 2 o EVERY'[rtac (dtor_inject RS iffD1), rtac trans, rtac map_simp,
|
blanchet@49501
|
1544 |
rtac box_equals, rtac map_comp, rtac (dtor_ctor RS sym RS arg_cong), rtac trans,
|
blanchet@48975
|
1545 |
rtac map_cong, REPEAT_DETERM_N m o rtac @{thm fun_cong[OF o_id]},
|
blanchet@49506
|
1546 |
EVERY' (map (fn in_Jsrel => EVERY' [rtac trans, rtac o_apply, dtac set_rev_mp, atac,
|
blanchet@49506
|
1547 |
dtac @{thm ssubst_mem[OF pair_collapse]}, dtac (in_Jsrel RS iffD1),
|
blanchet@49506
|
1548 |
dtac @{thm someI_ex}, REPEAT_DETERM o etac conjE, atac]) in_Jsrels),
|
blanchet@48975
|
1549 |
atac]]
|
blanchet@48975
|
1550 |
in
|
blanchet@48975
|
1551 |
EVERY' [rtac iffI, if_tac, only_if_tac] 1
|
blanchet@48975
|
1552 |
end;
|
blanchet@48975
|
1553 |
|
blanchet@48975
|
1554 |
end;
|