13 val mk_comp': thm -> thm |
13 val mk_comp': thm -> thm |
14 val mk_in_mono_tac: int -> tactic |
14 val mk_in_mono_tac: int -> tactic |
15 val mk_map_wppull_tac: thm -> thm -> thm -> thm -> thm list -> tactic |
15 val mk_map_wppull_tac: thm -> thm -> thm -> thm -> thm list -> tactic |
16 val mk_set_natural': thm -> thm |
16 val mk_set_natural': thm -> thm |
17 |
17 |
18 val mk_rel_Gr_tac: thm list -> thm -> thm -> thm -> thm -> thm list -> |
18 val mk_srel_Gr_tac: thm list -> thm -> thm -> thm -> thm -> thm list -> |
19 {prems: thm list, context: Proof.context} -> tactic |
19 {prems: thm list, context: Proof.context} -> tactic |
20 val mk_rel_Id_tac: int -> thm -> thm -> {prems: 'a, context: Proof.context} -> tactic |
20 val mk_srel_Id_tac: int -> thm -> thm -> {prems: 'a, context: Proof.context} -> tactic |
21 val mk_rel_O_tac: thm list -> thm -> thm -> thm -> thm -> thm list -> |
21 val mk_srel_O_tac: thm list -> thm -> thm -> thm -> thm -> thm list -> |
22 {prems: thm list, context: Proof.context} -> tactic |
22 {prems: thm list, context: Proof.context} -> tactic |
23 val mk_in_rel_tac: thm list -> int -> {prems: 'b, context: Proof.context} -> tactic |
23 val mk_in_srel_tac: thm list -> int -> {prems: 'b, context: Proof.context} -> tactic |
24 val mk_rel_converse_tac: thm -> tactic |
24 val mk_srel_converse_tac: thm -> tactic |
25 val mk_rel_converse_le_tac: thm list -> thm -> thm -> thm -> thm list -> |
25 val mk_srel_converse_le_tac: thm list -> thm -> thm -> thm -> thm list -> |
26 {prems: thm list, context: Proof.context} -> tactic |
26 {prems: thm list, context: Proof.context} -> tactic |
27 val mk_rel_mono_tac: thm list -> thm -> {prems: 'a, context: Proof.context} -> tactic |
27 val mk_srel_mono_tac: thm list -> thm -> {prems: 'a, context: Proof.context} -> tactic |
28 end; |
28 end; |
29 |
29 |
30 structure BNF_Def_Tactics : BNF_DEF_TACTICS = |
30 structure BNF_Def_Tactics : BNF_DEF_TACTICS = |
31 struct |
31 struct |
32 |
32 |
61 rtac (map_comp RS trans RS sym), rtac map_cong, |
61 rtac (map_comp RS trans RS sym), rtac map_cong, |
62 REPEAT_DETERM_N (length set_naturals) o EVERY' [rtac (o_apply RS trans), |
62 REPEAT_DETERM_N (length set_naturals) o EVERY' [rtac (o_apply RS trans), |
63 rtac (o_apply RS trans RS sym), rtac (o_apply RS trans), rtac thm, |
63 rtac (o_apply RS trans RS sym), rtac (o_apply RS trans), rtac thm, |
64 rtac conjunct2, etac bspec, etac set_mp, atac]]) [conjunct1, conjunct2]] 1; |
64 rtac conjunct2, etac bspec, etac set_mp, atac]]) [conjunct1, conjunct2]] 1; |
65 |
65 |
66 fun mk_rel_Gr_tac rel_O_Grs map_id map_cong map_id' map_comp set_naturals |
66 fun mk_srel_Gr_tac srel_O_Grs map_id map_cong map_id' map_comp set_naturals |
67 {context = ctxt, prems = _} = |
67 {context = ctxt, prems = _} = |
68 let |
68 let |
69 val n = length set_naturals; |
69 val n = length set_naturals; |
70 in |
70 in |
71 if null set_naturals then |
71 if null set_naturals then |
72 unfold_thms_tac ctxt rel_O_Grs THEN EVERY' [rtac @{thm Gr_UNIV_id}, rtac map_id] 1 |
72 unfold_thms_tac ctxt srel_O_Grs THEN EVERY' [rtac @{thm Gr_UNIV_id}, rtac map_id] 1 |
73 else unfold_thms_tac ctxt (@{thm Gr_def} :: rel_O_Grs) THEN |
73 else unfold_thms_tac ctxt (@{thm Gr_def} :: srel_O_Grs) THEN |
74 EVERY' [rtac equalityI, rtac subsetI, |
74 EVERY' [rtac equalityI, rtac subsetI, |
75 REPEAT_DETERM o eresolve_tac [CollectE, exE, conjE, @{thm relcompE}, @{thm converseE}], |
75 REPEAT_DETERM o eresolve_tac [CollectE, exE, conjE, @{thm relcompE}, @{thm converseE}], |
76 REPEAT_DETERM o dtac Pair_eqD, |
76 REPEAT_DETERM o dtac Pair_eqD, |
77 REPEAT_DETERM o etac conjE, hyp_subst_tac, |
77 REPEAT_DETERM o etac conjE, hyp_subst_tac, |
78 rtac CollectI, rtac exI, rtac conjI, rtac Pair_eqI, rtac conjI, rtac refl, |
78 rtac CollectI, rtac exI, rtac conjI, rtac Pair_eqI, rtac conjI, rtac refl, |
102 rtac @{thm convol_memI[of id _ "%x. x", OF id_apply refl]}, etac set_mp, atac]) |
102 rtac @{thm convol_memI[of id _ "%x. x", OF id_apply refl]}, etac set_mp, atac]) |
103 set_naturals]) |
103 set_naturals]) |
104 @{thms fst_convol snd_convol} [map_id', refl])] 1 |
104 @{thms fst_convol snd_convol} [map_id', refl])] 1 |
105 end; |
105 end; |
106 |
106 |
107 fun mk_rel_Id_tac n rel_Gr map_id {context = ctxt, prems = _} = |
107 fun mk_srel_Id_tac n srel_Gr map_id {context = ctxt, prems = _} = |
108 unfold_thms_tac ctxt [rel_Gr, @{thm Id_alt}] THEN |
108 unfold_thms_tac ctxt [srel_Gr, @{thm Id_alt}] THEN |
109 subst_tac ctxt [map_id] 1 THEN |
109 subst_tac ctxt [map_id] 1 THEN |
110 (if n = 0 then rtac refl 1 |
110 (if n = 0 then rtac refl 1 |
111 else EVERY' [rtac @{thm arg_cong2[of _ _ _ _ Gr]}, |
111 else EVERY' [rtac @{thm arg_cong2[of _ _ _ _ Gr]}, |
112 rtac equalityI, rtac subset_UNIV, rtac subsetI, rtac CollectI, |
112 rtac equalityI, rtac subset_UNIV, rtac subsetI, rtac CollectI, |
113 CONJ_WRAP' (K (rtac subset_UNIV)) (1 upto n), rtac refl] 1); |
113 CONJ_WRAP' (K (rtac subset_UNIV)) (1 upto n), rtac refl] 1); |
114 |
114 |
115 fun mk_rel_mono_tac rel_O_Grs in_mono {context = ctxt, prems = _} = |
115 fun mk_srel_mono_tac srel_O_Grs in_mono {context = ctxt, prems = _} = |
116 unfold_thms_tac ctxt rel_O_Grs THEN |
116 unfold_thms_tac ctxt srel_O_Grs THEN |
117 EVERY' [rtac @{thm relcomp_mono}, rtac @{thm iffD2[OF converse_mono]}, |
117 EVERY' [rtac @{thm relcomp_mono}, rtac @{thm iffD2[OF converse_mono]}, |
118 rtac @{thm Gr_mono}, rtac in_mono, REPEAT_DETERM o atac, |
118 rtac @{thm Gr_mono}, rtac in_mono, REPEAT_DETERM o atac, |
119 rtac @{thm Gr_mono}, rtac in_mono, REPEAT_DETERM o atac] 1; |
119 rtac @{thm Gr_mono}, rtac in_mono, REPEAT_DETERM o atac] 1; |
120 |
120 |
121 fun mk_rel_converse_le_tac rel_O_Grs rel_Id map_cong map_comp set_naturals |
121 fun mk_srel_converse_le_tac srel_O_Grs srel_Id map_cong map_comp set_naturals |
122 {context = ctxt, prems = _} = |
122 {context = ctxt, prems = _} = |
123 let |
123 let |
124 val n = length set_naturals; |
124 val n = length set_naturals; |
125 in |
125 in |
126 if null set_naturals then |
126 if null set_naturals then |
127 unfold_thms_tac ctxt [rel_Id] THEN rtac equalityD2 1 THEN rtac @{thm converse_Id} 1 |
127 unfold_thms_tac ctxt [srel_Id] THEN rtac equalityD2 1 THEN rtac @{thm converse_Id} 1 |
128 else unfold_thms_tac ctxt (@{thm Gr_def} :: rel_O_Grs) THEN |
128 else unfold_thms_tac ctxt (@{thm Gr_def} :: srel_O_Grs) THEN |
129 EVERY' [rtac @{thm subrelI}, |
129 EVERY' [rtac @{thm subrelI}, |
130 REPEAT_DETERM o eresolve_tac [CollectE, exE, conjE, @{thm relcompE}, @{thm converseE}], |
130 REPEAT_DETERM o eresolve_tac [CollectE, exE, conjE, @{thm relcompE}, @{thm converseE}], |
131 REPEAT_DETERM o dtac Pair_eqD, |
131 REPEAT_DETERM o dtac Pair_eqD, |
132 REPEAT_DETERM o etac conjE, hyp_subst_tac, rtac @{thm converseI}, |
132 REPEAT_DETERM o etac conjE, hyp_subst_tac, rtac @{thm converseI}, |
133 rtac @{thm relcompI}, rtac @{thm converseI}, |
133 rtac @{thm relcompI}, rtac @{thm converseI}, |
137 rtac (map_comp RS sym), rtac CollectI, |
137 rtac (map_comp RS sym), rtac CollectI, |
138 CONJ_WRAP' (fn thm => EVERY' [rtac (thm RS @{thm ord_eq_le_trans}), |
138 CONJ_WRAP' (fn thm => EVERY' [rtac (thm RS @{thm ord_eq_le_trans}), |
139 etac @{thm flip_rel}]) set_naturals]) [@{thm snd_fst_flip}, @{thm fst_snd_flip}])] 1 |
139 etac @{thm flip_rel}]) set_naturals]) [@{thm snd_fst_flip}, @{thm fst_snd_flip}])] 1 |
140 end; |
140 end; |
141 |
141 |
142 fun mk_rel_converse_tac le_converse = |
142 fun mk_srel_converse_tac le_converse = |
143 EVERY' [rtac equalityI, rtac le_converse, rtac @{thm xt1(6)}, rtac @{thm converse_shift}, |
143 EVERY' [rtac equalityI, rtac le_converse, rtac @{thm xt1(6)}, rtac @{thm converse_shift}, |
144 rtac le_converse, REPEAT_DETERM o stac @{thm converse_converse}, rtac subset_refl] 1; |
144 rtac le_converse, REPEAT_DETERM o stac @{thm converse_converse}, rtac subset_refl] 1; |
145 |
145 |
146 fun mk_rel_O_tac rel_O_Grs rel_Id map_cong map_wppull map_comp set_naturals |
146 fun mk_srel_O_tac srel_O_Grs srel_Id map_cong map_wppull map_comp set_naturals |
147 {context = ctxt, prems = _} = |
147 {context = ctxt, prems = _} = |
148 let |
148 let |
149 val n = length set_naturals; |
149 val n = length set_naturals; |
150 fun in_tac nthO_in = rtac CollectI THEN' |
150 fun in_tac nthO_in = rtac CollectI THEN' |
151 CONJ_WRAP' (fn thm => EVERY' [rtac (thm RS @{thm ord_eq_le_trans}), |
151 CONJ_WRAP' (fn thm => EVERY' [rtac (thm RS @{thm ord_eq_le_trans}), |
152 rtac @{thm image_subsetI}, rtac nthO_in, etac set_mp, atac]) set_naturals; |
152 rtac @{thm image_subsetI}, rtac nthO_in, etac set_mp, atac]) set_naturals; |
153 in |
153 in |
154 if null set_naturals then unfold_thms_tac ctxt [rel_Id] THEN rtac (@{thm Id_O_R} RS sym) 1 |
154 if null set_naturals then unfold_thms_tac ctxt [srel_Id] THEN rtac (@{thm Id_O_R} RS sym) 1 |
155 else unfold_thms_tac ctxt (@{thm Gr_def} :: rel_O_Grs) THEN |
155 else unfold_thms_tac ctxt (@{thm Gr_def} :: srel_O_Grs) THEN |
156 EVERY' [rtac equalityI, rtac @{thm subrelI}, |
156 EVERY' [rtac equalityI, rtac @{thm subrelI}, |
157 REPEAT_DETERM o eresolve_tac [CollectE, exE, conjE, @{thm relcompE}, @{thm converseE}], |
157 REPEAT_DETERM o eresolve_tac [CollectE, exE, conjE, @{thm relcompE}, @{thm converseE}], |
158 REPEAT_DETERM o dtac Pair_eqD, |
158 REPEAT_DETERM o dtac Pair_eqD, |
159 REPEAT_DETERM o etac conjE, hyp_subst_tac, |
159 REPEAT_DETERM o etac conjE, hyp_subst_tac, |
160 rtac @{thm relcompI}, rtac @{thm relcompI}, rtac @{thm converseI}, |
160 rtac @{thm relcompI}, rtac @{thm relcompI}, rtac @{thm converseI}, |
191 rtac conjI, rtac Pair_eqI, rtac conjI, rtac refl, rtac sym, rtac trans, |
191 rtac conjI, rtac Pair_eqI, rtac conjI, rtac refl, rtac sym, rtac trans, |
192 rtac trans, rtac map_cong, REPEAT_DETERM_N n o rtac thm, |
192 rtac trans, rtac map_cong, REPEAT_DETERM_N n o rtac thm, |
193 rtac (map_comp RS sym), atac, atac]) [@{thm fst_fstO}, @{thm snd_sndO}])] 1 |
193 rtac (map_comp RS sym), atac, atac]) [@{thm fst_fstO}, @{thm snd_sndO}])] 1 |
194 end; |
194 end; |
195 |
195 |
196 fun mk_in_rel_tac rel_O_Grs m {context = ctxt, prems = _} = |
196 fun mk_in_srel_tac srel_O_Grs m {context = ctxt, prems = _} = |
197 let |
197 let |
198 val ls' = replicate (Int.max (1, m)) (); |
198 val ls' = replicate (Int.max (1, m)) (); |
199 in |
199 in |
200 unfold_thms_tac ctxt (rel_O_Grs @ |
200 unfold_thms_tac ctxt (srel_O_Grs @ |
201 @{thms Gr_def converse_unfold relcomp_unfold mem_Collect_eq prod.cases Pair_eq}) THEN |
201 @{thms Gr_def converse_unfold relcomp_unfold mem_Collect_eq prod.cases Pair_eq}) THEN |
202 EVERY' [rtac iffI, REPEAT_DETERM o eresolve_tac [exE, conjE], hyp_subst_tac, rtac exI, |
202 EVERY' [rtac iffI, REPEAT_DETERM o eresolve_tac [exE, conjE], hyp_subst_tac, rtac exI, |
203 rtac conjI, CONJ_WRAP' (K atac) ls', rtac conjI, rtac refl, rtac refl, |
203 rtac conjI, CONJ_WRAP' (K atac) ls', rtac conjI, rtac refl, rtac refl, |
204 REPEAT_DETERM o eresolve_tac [exE, conjE], rtac exI, rtac conjI, |
204 REPEAT_DETERM o eresolve_tac [exE, conjE], rtac exI, rtac conjI, |
205 REPEAT_DETERM_N 2 o EVERY' [rtac exI, rtac conjI, etac @{thm conjI[OF refl sym]}, |
205 REPEAT_DETERM_N 2 o EVERY' [rtac exI, rtac conjI, etac @{thm conjI[OF refl sym]}, |