17 val protect: thm -> thm |
19 val protect: thm -> thm |
18 val conclude: thm -> thm |
20 val conclude: thm -> thm |
19 val finish: thm -> thm |
21 val finish: thm -> thm |
20 val norm_result: thm -> thm |
22 val norm_result: thm -> thm |
21 val close_result: thm -> thm |
23 val close_result: thm -> thm |
22 val compose_hhf: thm -> int -> thm -> thm Seq.seq |
|
23 val compose_hhf_tac: thm -> int -> tactic |
|
24 val comp_hhf: thm -> thm -> thm |
|
25 val prove_raw: cterm list -> cterm -> (thm list -> tactic) -> thm |
24 val prove_raw: cterm list -> cterm -> (thm list -> tactic) -> thm |
26 val prove_multi: Proof.context -> string list -> term list -> term list -> |
25 val prove_multi: Proof.context -> string list -> term list -> term list -> |
27 ({prems: thm list, context: Proof.context} -> tactic) -> thm list |
26 ({prems: thm list, context: Proof.context} -> tactic) -> thm list |
28 val prove: Proof.context -> string list -> term list -> term -> |
27 val prove: Proof.context -> string list -> term list -> term -> |
29 ({prems: thm list, context: Proof.context} -> tactic) -> thm |
28 ({prems: thm list, context: Proof.context} -> tactic) -> thm |
30 val prove_global: theory -> string list -> term list -> term -> (thm list -> tactic) -> thm |
29 val prove_global: theory -> string list -> term list -> term -> (thm list -> tactic) -> thm |
31 val extract: int -> int -> thm -> thm Seq.seq |
30 val extract: int -> int -> thm -> thm Seq.seq |
32 val retrofit: int -> int -> thm -> thm -> thm Seq.seq |
31 val retrofit: int -> int -> thm -> thm -> thm Seq.seq |
|
32 val conjunction_tac: int -> tactic |
|
33 val precise_conjunction_tac: int -> int -> tactic |
|
34 val asm_rewrite_goal_tac: bool * bool * bool -> (simpset -> tactic) -> simpset -> int -> tactic |
|
35 val rewrite_goal_tac: thm list -> int -> tactic |
|
36 val norm_hhf_tac: int -> tactic |
|
37 val compose_hhf: thm -> int -> thm -> thm Seq.seq |
|
38 val compose_hhf_tac: thm -> int -> tactic |
|
39 val comp_hhf: thm -> thm -> thm |
33 end; |
40 end; |
34 |
41 |
35 structure Goal: GOAL = |
42 structure Goal: GOAL = |
36 struct |
43 struct |
37 |
44 |
88 #> Drule.zero_var_indexes; |
95 #> Drule.zero_var_indexes; |
89 |
96 |
90 val close_result = |
97 val close_result = |
91 Thm.compress |
98 Thm.compress |
92 #> Drule.close_derivation; |
99 #> Drule.close_derivation; |
93 |
|
94 |
|
95 (* composition of normal results *) |
|
96 |
|
97 fun compose_hhf tha i thb = |
|
98 Thm.bicompose false (false, Drule.lift_all (Thm.cprem_of thb i) tha, 0) i thb; |
|
99 |
|
100 fun compose_hhf_tac th i = PRIMSEQ (compose_hhf th i); |
|
101 |
|
102 fun comp_hhf tha thb = |
|
103 (case Seq.chop 2 (compose_hhf tha 1 thb) of |
|
104 ([th], _) => th |
|
105 | ([], _) => raise THM ("comp_hhf: no unifiers", 1, [tha, thb]) |
|
106 | _ => raise THM ("comp_hhf: multiple unifiers", 1, [tha, thb])); |
|
107 |
100 |
108 |
101 |
109 |
102 |
110 (** tactical theorem proving **) |
103 (** tactical theorem proving **) |
111 |
104 |
162 fun prove_global thy xs asms prop tac = |
155 fun prove_global thy xs asms prop tac = |
163 Drule.standard (prove (ProofContext.init thy) xs asms prop (fn {prems, ...} => tac prems)); |
156 Drule.standard (prove (ProofContext.init thy) xs asms prop (fn {prems, ...} => tac prems)); |
164 |
157 |
165 |
158 |
166 |
159 |
167 (** local goal states **) |
160 (** goal structure **) |
|
161 |
|
162 (* nested goals *) |
168 |
163 |
169 fun extract i n st = |
164 fun extract i n st = |
170 (if i < 1 orelse n < 1 orelse i + n - 1 > Thm.nprems_of st then Seq.empty |
165 (if i < 1 orelse n < 1 orelse i + n - 1 > Thm.nprems_of st then Seq.empty |
171 else if n = 1 then Seq.single (Thm.cprem_of st i) |
166 else if n = 1 then Seq.single (Thm.cprem_of st i) |
172 else Seq.single (foldr1 Conjunction.mk_conjunction (map (Thm.cprem_of st) (i upto i + n - 1)))) |
167 else Seq.single (foldr1 Conjunction.mk_conjunction (map (Thm.cprem_of st) (i upto i + n - 1)))) |
179 |
174 |
180 fun SELECT_GOAL tac i st = |
175 fun SELECT_GOAL tac i st = |
181 if Thm.nprems_of st = 1 andalso i = 1 then tac st |
176 if Thm.nprems_of st = 1 andalso i = 1 then tac st |
182 else Seq.lifts (retrofit i 1) (Seq.maps tac (extract i 1 st)) st; |
177 else Seq.lifts (retrofit i 1) (Seq.maps tac (extract i 1 st)) st; |
183 |
178 |
|
179 |
|
180 (* multiple goals *) |
|
181 |
|
182 val conj_tac = SUBGOAL (fn (goal, i) => |
|
183 if can Logic.dest_conjunction goal then rtac Conjunction.conjunctionI i |
|
184 else no_tac); |
|
185 |
|
186 val conjunction_tac = TRY o REPEAT_ALL_NEW conj_tac; |
|
187 |
|
188 val precise_conjunction_tac = |
|
189 let |
|
190 fun tac 0 i = eq_assume_tac i |
|
191 | tac 1 i = SUBGOAL (K all_tac) i |
|
192 | tac n i = conj_tac i THEN TRY (fn st => tac (n - 1) (i + 1) st); |
|
193 in TRY oo tac end; |
|
194 |
|
195 fun CONJUNCTS tac = |
|
196 SELECT_GOAL (conjunction_tac 1 |
|
197 THEN tac |
|
198 THEN PRIMITIVE (Conjunction.uncurry ~1)); |
|
199 |
|
200 fun PRECISE_CONJUNCTS n tac = |
|
201 SELECT_GOAL (precise_conjunction_tac n 1 |
|
202 THEN tac |
|
203 THEN PRIMITIVE (Conjunction.uncurry ~1)); |
|
204 |
|
205 |
|
206 (* rewriting *) |
|
207 |
|
208 (*Rewrite subgoal i only. SELECT_GOAL avoids inefficiencies in goals_conv.*) |
|
209 fun asm_rewrite_goal_tac mode prover_tac ss = |
|
210 SELECT_GOAL |
|
211 (PRIMITIVE (MetaSimplifier.rewrite_goal_rule mode (SINGLE o prover_tac) ss 1)); |
|
212 |
|
213 fun rewrite_goal_tac rews = |
|
214 let val ss = MetaSimplifier.empty_ss addsimps rews in |
|
215 fn i => fn st => asm_rewrite_goal_tac (true, false, false) (K no_tac) |
|
216 (MetaSimplifier.theory_context (Thm.theory_of_thm st) ss) i st |
|
217 end; |
|
218 |
|
219 |
|
220 (* hhf normal form *) |
|
221 |
|
222 val norm_hhf_tac = |
|
223 rtac Drule.asm_rl (*cheap approximation -- thanks to builtin Logic.flatten_params*) |
|
224 THEN' SUBGOAL (fn (t, i) => |
|
225 if Drule.is_norm_hhf t then all_tac |
|
226 else rewrite_goal_tac [Drule.norm_hhf_eq] i); |
|
227 |
|
228 fun compose_hhf tha i thb = |
|
229 Thm.bicompose false (false, Drule.lift_all (Thm.cprem_of thb i) tha, 0) i thb; |
|
230 |
|
231 fun compose_hhf_tac th i = PRIMSEQ (compose_hhf th i); |
|
232 |
|
233 fun comp_hhf tha thb = |
|
234 (case Seq.chop 2 (compose_hhf tha 1 thb) of |
|
235 ([th], _) => th |
|
236 | ([], _) => raise THM ("comp_hhf: no unifiers", 1, [tha, thb]) |
|
237 | _ => raise THM ("comp_hhf: multiple unifiers", 1, [tha, thb])); |
|
238 |
184 end; |
239 end; |
185 |
240 |
186 structure BasicGoal: BASIC_GOAL = Goal; |
241 structure BasicGoal: BASIC_GOAL = Goal; |
187 open BasicGoal; |
242 open BasicGoal; |