4 |
4 |
5 A tactic to generate fresh names. |
5 A tactic to generate fresh names. |
6 A tactic to get rid of the fresh_fun. |
6 A tactic to get rid of the fresh_fun. |
7 *) |
7 *) |
8 |
8 |
9 (* First some functions that could be |
9 (* First some functions that could be in the library *) |
10 in the library *) |
|
11 |
10 |
12 (* A tactical which applies a list of int -> tactic to the corresponding subgoals present after the application of another tactic. |
11 (* A tactical which applies a list of int -> tactic to the corresponding subgoals present after the application of another tactic. |
13 T THENL [A,B,C] is equivalent to T THEN (C 3 THEN B 2 THEN A 1) |
12 T THENL [A,B,C] is equivalent to T THEN (C 3 THEN B 2 THEN A 1) |
14 *) |
13 *) |
15 |
14 |
17 |
16 |
18 fun tac THENL tacs = |
17 fun tac THENL tacs = |
19 tac THEN |
18 tac THEN |
20 (EVERY (map (fn (tac,i) => tac i) (rev tacs ~~ (length tacs downto 1)))) |
19 (EVERY (map (fn (tac,i) => tac i) (rev tacs ~~ (length tacs downto 1)))) |
21 |
20 |
|
21 (* A tactical to test if a tactic completly solve a subgoal *) |
|
22 |
22 fun SOLVEI t = t THEN_ALL_NEW (fn i => no_tac); |
23 fun SOLVEI t = t THEN_ALL_NEW (fn i => no_tac); |
|
24 |
|
25 (* A version of TRY for int -> tactic *) |
|
26 |
23 fun TRY' tac i = TRY (tac i); |
27 fun TRY' tac i = TRY (tac i); |
24 |
28 |
25 fun gen_res_inst_tac_term instf tyinst tinst elim th i st = |
29 fun gen_res_inst_tac_term instf tyinst tinst elim th i st = |
26 let |
30 let |
27 val thy = theory_of_thm st; |
31 val thy = theory_of_thm st; |
119 case atom_name_opt of |
123 case atom_name_opt of |
120 NONE => all_tac thm |
124 NONE => all_tac thm |
121 | SOME atom_name => generate_fresh_tac atom_name i thm |
125 | SOME atom_name => generate_fresh_tac atom_name i thm |
122 end |
126 end |
123 |
127 |
124 (* A substitution tactic *) |
128 (* Two substitution tactics which looks for the inner most occurence in |
|
129 one assumption or in the conclusion *) |
125 |
130 |
126 val search_fun = curry (Seq.flat o (uncurry EqSubst.searchf_bt_unify_valid)); |
131 val search_fun = curry (Seq.flat o (uncurry EqSubst.searchf_bt_unify_valid)); |
127 val search_fun_asm = EqSubst.skip_first_asm_occs_search EqSubst.searchf_bt_unify_valid; |
132 val search_fun_asm = EqSubst.skip_first_asm_occs_search EqSubst.searchf_bt_unify_valid; |
128 |
133 |
129 fun subst_outer_tac ctx = EqSubst.eqsubst_tac' ctx search_fun; |
134 fun subst_inner_tac ctx = EqSubst.eqsubst_tac' ctx search_fun; |
130 fun subst_outer_asm_tac_aux i ctx = EqSubst.eqsubst_asm_tac' ctx search_fun_asm i; |
135 fun subst_inner_asm_tac_aux i ctx = EqSubst.eqsubst_asm_tac' ctx search_fun_asm i; |
131 |
136 |
132 fun subst_outer_asm_tac ctx th = curry (curry (FIRST' (map uncurry (map uncurry (map subst_outer_asm_tac_aux (1 upto Thm.nprems_of th)))))) ctx th; |
137 (* A tactic to substitute in the first assumption |
133 |
138 which contains an occurence. *) |
134 fun fresh_fun_tac i thm = |
139 |
|
140 fun subst_inner_asm_tac ctx th = curry (curry (FIRST' (map uncurry (map uncurry (map subst_inner_asm_tac_aux (1 upto Thm.nprems_of th)))))) ctx th; |
|
141 |
|
142 fun fresh_fun_tac no_asm i thm = |
135 (* Find the variable we instantiate *) |
143 (* Find the variable we instantiate *) |
136 let |
144 let |
137 val thy = theory_of_thm thm; |
145 val thy = theory_of_thm thm; |
138 val ctx = Context.init_proof thy; |
146 val ctx = Context.init_proof thy; |
139 val ss = simpset_of thy; |
147 val ss = simpset_of thy; |
160 in case vars' \\ vars of |
168 in case vars' \\ vars of |
161 [x] => Seq.single (Thm.instantiate ([],[(cterm_of thy x,cterm_of thy (list_abs (params,Bound 0)))]) st) |
169 [x] => Seq.single (Thm.instantiate ([],[(cterm_of thy x,cterm_of thy (list_abs (params,Bound 0)))]) st) |
162 | _ => error "fresh_fun_simp: Too many variables, please report." |
170 | _ => error "fresh_fun_simp: Too many variables, please report." |
163 end |
171 end |
164 in |
172 in |
165 ( (* generate_fresh_tac atom_name i THEN *) |
173 ((fn st => |
166 (fn st => |
|
167 let |
174 let |
168 val vars = term_vars (prop_of st); |
175 val vars = term_vars (prop_of st); |
169 val params = Logic.strip_params (nth (prems_of st) (i-1)) |
176 val params = Logic.strip_params (nth (prems_of st) (i-1)) |
|
177 (* The tactics which solve the subgoals generated |
|
178 by the conditionnal rewrite rule. *) |
170 val post_rewrite_tacs = |
179 val post_rewrite_tacs = |
171 [rtac pt_name_inst, |
180 [rtac pt_name_inst, |
172 rtac at_name_inst, |
181 rtac at_name_inst, |
173 TRY' (SOLVEI (NominalPermeq.finite_guess_tac ss'')), |
182 TRY' (SOLVEI (NominalPermeq.finite_guess_tac ss'')), |
174 inst_fresh vars params THEN' |
183 inst_fresh vars params THEN' |
175 (TRY' (SOLVEI (NominalPermeq.fresh_guess_tac ss''))) THEN' |
184 (TRY' (SOLVEI (NominalPermeq.fresh_guess_tac ss''))) THEN' |
176 (TRY' (SOLVEI (asm_full_simp_tac ss'')))] |
185 (TRY' (SOLVEI (asm_full_simp_tac ss'')))] |
177 in |
186 in |
178 ((subst_outer_asm_tac ctx fresh_fun_app' i THENL post_rewrite_tacs) ORELSE |
187 ((if no_asm then |
179 (subst_outer_tac ctx fresh_fun_app' i THENL post_rewrite_tacs)) st |
188 (subst_inner_asm_tac ctx fresh_fun_app' i THENL post_rewrite_tacs) |
|
189 else |
|
190 no_tac) |
|
191 ORELSE |
|
192 (subst_inner_tac ctx fresh_fun_app' i THENL post_rewrite_tacs)) st |
180 end)) thm |
193 end)) thm |
181 |
194 |
182 end |
195 end |
183 end |
196 end |
184 |
197 |
|
198 (* syntax for options, given "(no_asm)" will give back true, without |
|
199 gives back false *) |
|
200 val options_syntax = |
|
201 (Args.parens (Args.$$$ "no_asm") >> (K true)) || |
|
202 (Scan.succeed false); |
|
203 |
185 val setup_generate_fresh = |
204 val setup_generate_fresh = |
186 Method.goal_args_ctxt' Args.tyname (fn ctxt => generate_fresh_tac) |
205 Method.goal_args_ctxt' Args.tyname (fn ctxt => generate_fresh_tac) |
187 |
206 |
188 val setup_fresh_fun_simp = |
207 val setup_fresh_fun_simp = |
189 Method.no_args (Method.SIMPLE_METHOD (fresh_fun_tac 1)) |
208 Method.simple_args options_syntax |
|
209 (fn b => fn _ => Method.SIMPLE_METHOD (fresh_fun_tac b 1)) |