18 val conclude: thm -> thm |
18 val conclude: thm -> thm |
19 val finish: thm -> thm |
19 val finish: thm -> thm |
20 val compose_hhf: thm -> int -> thm -> thm Seq.seq |
20 val compose_hhf: thm -> int -> thm -> thm Seq.seq |
21 val compose_hhf_tac: thm -> int -> tactic |
21 val compose_hhf_tac: thm -> int -> tactic |
22 val comp_hhf: thm -> thm -> thm |
22 val comp_hhf: thm -> thm -> thm |
|
23 val prove_raw: cterm list -> cterm -> (thm list -> tactic) -> thm |
23 val prove_multi: Context.proof -> string list -> term list -> term list -> |
24 val prove_multi: Context.proof -> string list -> term list -> term list -> |
24 (thm list -> tactic) -> thm list |
25 ({prems: thm list, context: Context.proof} -> tactic) -> thm list |
25 val prove: Context.proof -> string list -> term list -> term -> (thm list -> tactic) -> thm |
26 val prove: Context.proof -> string list -> term list -> term -> |
|
27 ({prems: thm list, context: Context.proof} -> tactic) -> thm |
26 val prove_global: theory -> string list -> term list -> term -> (thm list -> tactic) -> thm |
28 val prove_global: theory -> string list -> term list -> term -> (thm list -> tactic) -> thm |
27 val prove_raw: cterm list -> cterm -> (thm list -> tactic) -> thm |
|
28 val extract: int -> int -> thm -> thm Seq.seq |
29 val extract: int -> int -> thm -> thm Seq.seq |
29 val retrofit: int -> int -> thm -> thm -> thm Seq.seq |
30 val retrofit: int -> int -> thm -> thm -> thm Seq.seq |
30 end; |
31 end; |
31 |
32 |
32 structure Goal: GOAL = |
33 structure Goal: GOAL = |
89 |
90 |
90 |
91 |
91 |
92 |
92 (** tactical theorem proving **) |
93 (** tactical theorem proving **) |
93 |
94 |
|
95 (* prove_raw -- no checks, no normalization of result! *) |
|
96 |
|
97 fun prove_raw casms cprop tac = |
|
98 (case SINGLE (tac (map Assumption.assume casms)) (init cprop) of |
|
99 SOME th => Drule.implies_intr_list casms (finish th) |
|
100 | NONE => error "Tactic failed."); |
|
101 |
|
102 |
94 (* prove_multi *) |
103 (* prove_multi *) |
95 |
104 |
96 fun prove_multi ctxt xs asms props tac = |
105 fun prove_multi ctxt xs asms props tac = |
97 let |
106 let |
98 val thy = Context.theory_of_proof ctxt; |
107 val thy = Context.theory_of_proof ctxt; |
99 val string_of_term = Sign.string_of_term thy; |
108 val string_of_term = Sign.string_of_term thy; |
100 |
109 |
101 val prop = Logic.mk_conjunction_list props; |
110 fun err msg = cat_error msg |
102 val statement = Logic.list_implies (asms, prop); |
111 ("The error(s) above occurred for the goal statement:\n" ^ |
|
112 string_of_term (Logic.list_implies (asms, Logic.mk_conjunction_list props))); |
103 |
113 |
104 fun err msg = cat_error msg |
114 fun cert_safe t = Thm.cterm_of thy (Envir.beta_norm (Term.no_dummy_patterns t)) |
105 ("The error(s) above occurred for the goal statement:\n" ^ string_of_term statement); |
|
106 fun cert_safe t = Thm.cterm_of thy (Envir.beta_norm t) |
|
107 handle TERM (msg, _) => err msg | TYPE (msg, _, _) => err msg; |
115 handle TERM (msg, _) => err msg | TYPE (msg, _, _) => err msg; |
|
116 val casms = map cert_safe asms; |
|
117 val cprops = map cert_safe props; |
108 |
118 |
109 val _ = cert_safe statement; |
119 val (prems, ctxt') = ctxt |
110 val _ = Term.no_dummy_patterns statement handle TERM (msg, _) => err msg; |
120 |> Variable.add_fixes_direct xs |
111 val casms = map cert_safe asms; |
121 |> fold Variable.declare_internal (asms @ props) |
112 val prems = map (norm_hhf o Thm.assume) casms; |
122 |> Assumption.add_assumes casms; |
113 |
123 |
114 val ctxt' = ctxt |
124 val goal = init (Conjunction.mk_conjunction_list cprops); |
115 |> Variable.set_body false |
|
116 |> (snd o Variable.add_fixes xs) |
|
117 |> fold Variable.declare_internal (asms @ props); |
|
118 |
|
119 val res = |
125 val res = |
120 (case SINGLE (tac prems) (init (cert_safe prop)) of |
126 (case SINGLE (tac {prems = prems, context = ctxt'}) goal of |
121 NONE => err "Tactic failed." |
127 NONE => err "Tactic failed." |
122 | SOME res => res); |
128 | SOME res => res); |
123 val [results] = |
129 val [results] = Conjunction.elim_precise [length props] (finish res) |
124 Conjunction.elim_precise [length props] (finish res) handle THM (msg, _, _) => err msg; |
130 handle THM (msg, _, _) => err msg; |
125 val _ = Unify.matches_list thy (map (Thm.term_of o cert_safe) props) (map Thm.prop_of results) |
131 val _ = Unify.matches_list thy (map Thm.term_of cprops) (map Thm.prop_of results) |
126 orelse err ("Proved a different theorem: " ^ string_of_term (Thm.prop_of res)); |
132 orelse err ("Proved a different theorem: " ^ string_of_term (Thm.prop_of res)); |
127 in |
133 in |
128 results |
134 results |
129 |> map (Drule.implies_intr_list casms) |
135 |> (Seq.hd o Assumption.exports false ctxt' ctxt) |
130 |> Variable.export ctxt' ctxt |
136 |> Variable.export ctxt' ctxt |
131 |> map (norm_hhf #> Drule.zero_var_indexes) |
137 |> map Drule.zero_var_indexes |
132 end; |
138 end; |
133 |
139 |
134 |
140 |
135 (* prove *) |
141 (* prove *) |
136 |
142 |
137 fun prove ctxt xs asms prop tac = hd (prove_multi ctxt xs asms [prop] tac); |
143 fun prove ctxt xs asms prop tac = hd (prove_multi ctxt xs asms [prop] tac); |
138 |
144 |
139 fun prove_global thy xs asms prop tac = |
145 fun prove_global thy xs asms prop tac = |
140 Drule.standard (prove (Context.init_proof thy) xs asms prop tac); |
146 Drule.standard (prove (Context.init_proof thy) xs asms prop (fn {prems, ...} => tac prems)); |
141 |
|
142 |
|
143 (* prove_raw -- no checks, no normalization of result! *) |
|
144 |
|
145 fun prove_raw casms cprop tac = |
|
146 (case SINGLE (tac (map (norm_hhf o Thm.assume) casms)) (init cprop) of |
|
147 SOME th => Drule.implies_intr_list casms (finish th) |
|
148 | NONE => error "Tactic failed."); |
|
149 |
147 |
150 |
148 |
151 |
149 |
152 (** local goal states **) |
150 (** local goal states **) |
153 |
151 |