126 val params = map_filter (fn x => Option.map (pair x) (AList.lookup (op =) frees x)) xs; |
126 val params = map_filter (fn x => Option.map (pair x) (AList.lookup (op =) frees x)) xs; |
127 |
127 |
128 fun err msg = cat_error msg |
128 fun err msg = cat_error msg |
129 ("The error(s) above occurred for the goal statement:\n" ^ |
129 ("The error(s) above occurred for the goal statement:\n" ^ |
130 Sign.string_of_term thy (Term.list_all_free (params, statement))); |
130 Sign.string_of_term thy (Term.list_all_free (params, statement))); |
131 |
|
132 fun cert_safe t = Thm.cterm_of thy (Envir.beta_norm t) |
131 fun cert_safe t = Thm.cterm_of thy (Envir.beta_norm t) |
133 handle TERM (msg, _) => err msg | TYPE (msg, _, _) => err msg; |
132 handle TERM (msg, _) => err msg | TYPE (msg, _, _) => err msg; |
134 |
133 |
135 val _ = cert_safe statement; |
134 val _ = cert_safe statement; |
136 val _ = Term.no_dummy_patterns statement handle TERM (msg, _) => err msg; |
135 val _ = Term.no_dummy_patterns statement handle TERM (msg, _) => err msg; |
137 |
136 |
138 val cparams = map (cert_safe o Free) params; |
137 val cparams = map (cert_safe o Free) params; |
139 val casms = map cert_safe asms; |
138 val casms = map cert_safe asms; |
140 val prems = map (norm_hhf o Thm.assume) casms; |
139 val prems = map (norm_hhf o Thm.assume) casms; |
141 |
140 |
142 val cprop = cert_safe prop; |
141 val res = |
143 val goal = init cprop; |
142 (case SINGLE (tac prems) (init (cert_safe prop)) of |
144 val goal' = case SINGLE (tac prems) goal of SOME goal' => goal' | _ => err "Tactic failed."; |
143 NONE => err "Tactic failed." |
145 val raw_result = finish goal' handle THM (msg, _, _) => err msg; |
144 | SOME res => res); |
146 |
145 val [results] = |
147 val prop' = Thm.prop_of raw_result; |
146 Conjunction.elim_precise [length props] (finish res) handle THM (msg, _, _) => err msg; |
148 val _ = |
147 val _ = Pattern.matches_seq thy (map (Thm.term_of o cert_safe) props) (map Thm.prop_of results) |
149 if not (Pattern.matches thy (Envir.beta_norm (Thm.term_of cprop), prop')) |
148 orelse err ("Proved a different theorem: " ^ Sign.string_of_term thy (Thm.prop_of res)); |
150 then err ("Proved a different theorem: " ^ Sign.string_of_term thy prop') |
|
151 else (); |
|
152 in |
149 in |
153 hd (Conjunction.elim_precise [length props] raw_result) |
150 results |> map |
154 |> map |
|
155 (Drule.implies_intr_list casms |
151 (Drule.implies_intr_list casms |
156 #> Drule.forall_intr_list cparams |
152 #> Drule.forall_intr_list cparams |
157 #> norm_hhf |
153 #> norm_hhf |
158 #> Thm.varifyT' fixed_tfrees |
154 #> Thm.varifyT' fixed_tfrees |
159 #-> K Drule.zero_var_indexes) |
155 #-> K Drule.zero_var_indexes) |