5 A proof method to perform a substiution using an equation. |
5 A proof method to perform a substiution using an equation. |
6 *) |
6 *) |
7 |
7 |
8 signature EQSUBST = |
8 signature EQSUBST = |
9 sig |
9 sig |
10 val setup : theory -> theory |
10 (* a type abriviation for match information *) |
|
11 type match = |
|
12 ((indexname * (sort * typ)) list (* type instantiations *) |
|
13 * (indexname * (typ * term)) list) (* term instantiations *) |
|
14 * (string * typ) list (* fake named type abs env *) |
|
15 * (string * typ) list (* type abs env *) |
|
16 * term (* outer term *) |
|
17 |
|
18 type searchinfo = |
|
19 theory |
|
20 * int (* maxidx *) |
|
21 * Zipper.T (* focusterm to search under *) |
|
22 |
|
23 exception eqsubst_occL_exp of |
|
24 string * int list * Thm.thm list * int * Thm.thm |
|
25 |
|
26 (* low level substitution functions *) |
|
27 val apply_subst_in_asm : |
|
28 int -> |
|
29 Thm.thm -> |
|
30 Thm.thm -> |
|
31 (Thm.cterm list * int * 'a * Thm.thm) * match -> Thm.thm Seq.seq |
|
32 val apply_subst_in_concl : |
|
33 int -> |
|
34 Thm.thm -> |
|
35 Thm.cterm list * Thm.thm -> |
|
36 Thm.thm -> match -> Thm.thm Seq.seq |
|
37 |
|
38 (* matching/unification within zippers *) |
|
39 val clean_match_z : |
|
40 Context.theory -> Term.term -> Zipper.T -> match option |
|
41 val clean_unify_z : |
|
42 Context.theory -> int -> Term.term -> Zipper.T -> match Seq.seq |
|
43 |
|
44 (* skipping things in seq seq's *) |
|
45 |
|
46 (* skipping non-empty sub-sequences but when we reach the end |
|
47 of the seq, remembering how much we have left to skip. *) |
|
48 datatype 'a skipseq = SkipMore of int |
|
49 | SkipSeq of 'a Seq.seq Seq.seq; |
|
50 |
|
51 val skip_first_asm_occs_search : |
|
52 ('a -> 'b -> 'c Seq.seq Seq.seq) -> |
|
53 'a -> int -> 'b -> 'c skipseq |
|
54 val skip_first_occs_search : |
|
55 int -> ('a -> 'b -> 'c Seq.seq Seq.seq) -> 'a -> 'b -> 'c Seq.seq |
|
56 val skipto_skipseq : int -> 'a Seq.seq Seq.seq -> 'a skipseq |
|
57 |
|
58 (* tactics *) |
|
59 val eqsubst_asm_tac : |
|
60 Proof.context -> |
|
61 int list -> Thm.thm list -> int -> Thm.thm -> Thm.thm Seq.seq |
|
62 val eqsubst_asm_tac' : |
|
63 Proof.context -> |
|
64 (searchinfo -> int -> Term.term -> match skipseq) -> |
|
65 int -> Thm.thm -> int -> Thm.thm -> Thm.thm Seq.seq |
|
66 val eqsubst_tac : |
|
67 Proof.context -> |
|
68 int list -> Thm.thm list -> int -> Thm.thm -> Thm.thm Seq.seq |
|
69 val eqsubst_tac' : |
|
70 Proof.context -> |
|
71 (searchinfo -> Term.term -> match Seq.seq) |
|
72 -> Thm.thm -> int -> Thm.thm -> Thm.thm Seq.seq |
|
73 |
|
74 |
|
75 val fakefree_badbounds : |
|
76 (string * Term.typ) list -> |
|
77 Term.term -> |
|
78 (string * Term.typ) list * (string * Term.typ) list * Term.term |
|
79 |
|
80 val mk_foo_match : |
|
81 (Term.term -> Term.term) -> |
|
82 ('a * Term.typ) list -> Term.term -> Term.term |
|
83 |
|
84 (* preparing substitution *) |
|
85 val prep_meta_eq : Proof.context -> Thm.thm -> Thm.thm list |
|
86 val prep_concl_subst : |
|
87 int -> Thm.thm -> (Thm.cterm list * Thm.thm) * searchinfo |
|
88 val prep_subst_in_asm : |
|
89 int -> Thm.thm -> int -> |
|
90 (Thm.cterm list * int * int * Thm.thm) * searchinfo |
|
91 val prep_subst_in_asms : |
|
92 int -> Thm.thm -> |
|
93 ((Thm.cterm list * int * int * Thm.thm) * searchinfo) list |
|
94 val prep_zipper_match : |
|
95 Zipper.T -> Term.term * ((string * Term.typ) list * (string * Term.typ) list * Term.term) |
|
96 |
|
97 (* search for substitutions *) |
|
98 val valid_match_start : Zipper.T -> bool |
|
99 val search_lr_all : Zipper.T -> Zipper.T Seq.seq |
|
100 val search_lr_valid : (Zipper.T -> bool) -> Zipper.T -> Zipper.T Seq.seq |
|
101 val searchf_lr_unify_all : |
|
102 searchinfo -> Term.term -> match Seq.seq Seq.seq |
|
103 val searchf_lr_unify_valid : |
|
104 searchinfo -> Term.term -> match Seq.seq Seq.seq |
|
105 |
|
106 |
|
107 (* syntax tools *) |
|
108 val ith_syntax : Args.T list -> int list * Args.T list |
|
109 val options_syntax : Args.T list -> bool * Args.T list |
|
110 |
|
111 (* Isar level hooks *) |
|
112 val eqsubst_asm_meth : Proof.context -> int list -> Thm.thm list -> Method.method |
|
113 val eqsubst_meth : Proof.context -> int list -> Thm.thm list -> Method.method |
|
114 val subst_meth : Method.src -> ProofContext.context -> Method.method |
|
115 val setup : theory -> theory |
|
116 |
11 end; |
117 end; |
12 |
118 |
13 structure EqSubst |
119 structure EqSubst |
14 (* : EQSUBST *) |
120 : EQSUBST |
15 = struct |
121 = struct |
16 |
122 |
17 structure Z = Zipper; |
123 structure Z = Zipper; |
18 |
124 |
19 (* changes object "=" to meta "==" which prepares a given rewrite rule *) |
125 (* changes object "=" to meta "==" which prepares a given rewrite rule *) |
185 | Free _ => true |
291 | Free _ => true |
186 | Abs _ => true (* allowed to look inside abs... search decides if we actually consider the abstraction itself *) |
292 | Abs _ => true (* allowed to look inside abs... search decides if we actually consider the abstraction itself *) |
187 | _ => false); (* avoid vars - always suceeds uninterestingly. *) |
293 | _ => false); (* avoid vars - always suceeds uninterestingly. *) |
188 |
294 |
189 (* search from top, left to right, then down *) |
295 (* search from top, left to right, then down *) |
190 val search_tlr_all = ZipperSearch.all_td_lr; |
296 val search_lr_all = ZipperSearch.all_bl_ur; |
191 |
297 |
192 (* search from top, left to right, then down *) |
298 (* search from top, left to right, then down *) |
193 fun search_tlr_valid validf = |
299 fun search_lr_valid validf = |
194 let |
300 let |
195 fun sf_valid_td_lr z = |
301 fun sf_valid_td_lr z = |
196 let val here = if validf z then [Z.Here z] else [] in |
302 let val here = if validf z then [Z.Here z] else [] in |
197 case Z.trm z |
303 case Z.trm z |
198 of _ $ _ => here @ [Z.LookIn (Z.move_down_left z), |
304 of _ $ _ => [Z.LookIn (Z.move_down_left z)] |
199 Z.LookIn (Z.move_down_right z)] |
305 @ here |
|
306 @ [Z.LookIn (Z.move_down_right z)] |
200 | Abs _ => here @ [Z.LookIn (Z.move_down_abs z)] |
307 | Abs _ => here @ [Z.LookIn (Z.move_down_abs z)] |
201 | _ => here |
308 | _ => here |
202 end; |
309 end; |
203 in Z.lzy_search sf_valid_td_lr end; |
310 in Z.lzy_search sf_valid_td_lr end; |
204 |
311 |
205 (* search all unifications *) |
312 (* search all unifications *) |
206 fun searchf_tlr_unify_all (sgn, maxidx, z) lhs = |
313 fun searchf_lr_unify_all (sgn, maxidx, z) lhs = |
207 Seq.map (clean_unify_z sgn maxidx lhs) |
314 Seq.map (clean_unify_z sgn maxidx lhs) |
208 (Z.limit_apply search_tlr_all z); |
315 (Z.limit_apply search_lr_all z); |
209 |
316 |
210 (* search only for 'valid' unifiers (non abs subterms and non vars) *) |
317 (* search only for 'valid' unifiers (non abs subterms and non vars) *) |
211 fun searchf_tlr_unify_valid (sgn, maxidx, z) lhs = |
318 fun searchf_lr_unify_valid (sgn, maxidx, z) lhs = |
212 Seq.map (clean_unify_z sgn maxidx lhs) |
319 Seq.map (clean_unify_z sgn maxidx lhs) |
213 (Z.limit_apply (search_tlr_valid valid_match_start) z); |
320 (Z.limit_apply (search_lr_valid valid_match_start) z); |
214 |
321 |
215 |
322 |
216 (* apply a substitution in the conclusion of the theorem th *) |
323 (* apply a substitution in the conclusion of the theorem th *) |
217 (* cfvs are certified free var placeholders for goal params *) |
324 (* cfvs are certified free var placeholders for goal params *) |
218 (* conclthm is a theorem of for just the conclusion *) |
325 (* conclthm is a theorem of for just the conclusion *) |