36 val try_intros_tac: thm list -> thm list -> tactic |
36 val try_intros_tac: thm list -> thm list -> tactic |
37 val rule: Proof.context -> thm list -> method |
37 val rule: Proof.context -> thm list -> method |
38 val erule: Proof.context -> int -> thm list -> method |
38 val erule: Proof.context -> int -> thm list -> method |
39 val drule: Proof.context -> int -> thm list -> method |
39 val drule: Proof.context -> int -> thm list -> method |
40 val frule: Proof.context -> int -> thm list -> method |
40 val frule: Proof.context -> int -> thm list -> method |
41 val set_tactic: (thm list -> tactic) -> Proof.context -> Proof.context |
41 val set_tactic: (thm list -> tactic) -> Context.generic -> Context.generic |
42 val tactic: Symbol_Pos.source -> Proof.context -> method |
42 val tactic: Symbol_Pos.source -> Proof.context -> method |
43 val raw_tactic: Symbol_Pos.source -> Proof.context -> method |
43 val raw_tactic: Symbol_Pos.source -> Proof.context -> method |
44 type combinator_info |
44 type combinator_info |
45 val no_combinator_info: combinator_info |
45 val no_combinator_info: combinator_info |
46 datatype combinator = Then | Orelse | Try | Repeat1 | Select_Goals of int |
46 datatype combinator = Then | Orelse | Try | Repeat1 | Select_Goals of int |
245 |
245 |
246 val intros_tac = gen_intros_tac ALLGOALS; |
246 val intros_tac = gen_intros_tac ALLGOALS; |
247 val try_intros_tac = gen_intros_tac TRYALL; |
247 val try_intros_tac = gen_intros_tac TRYALL; |
248 |
248 |
249 |
249 |
250 (* ML tactics *) |
250 |
251 |
251 (** method syntax **) |
252 structure ML_Tactic = Proof_Data |
252 |
|
253 (* context data *) |
|
254 |
|
255 structure Data = Generic_Data |
253 ( |
256 ( |
254 type T = thm list -> tactic; |
257 type T = |
255 fun init _ = undefined; |
258 ((Token.src -> Proof.context -> method) * string) Name_Space.table * (*methods*) |
|
259 (thm list -> tactic) option; (*ML tactic*) |
|
260 val empty : T = (Name_Space.empty_table "method", NONE); |
|
261 val extend = I; |
|
262 fun merge ((tab, tac), (tab', tac')) : T = |
|
263 (Name_Space.merge_tables (tab, tab'), merge_options (tac, tac')); |
256 ); |
264 ); |
257 |
265 |
258 val set_tactic = ML_Tactic.put; |
266 val get_methods = fst o Data.get; |
|
267 val map_methods = Data.map o apfst; |
|
268 |
|
269 |
|
270 (* ML tactic *) |
|
271 |
|
272 val set_tactic = Data.map o apsnd o K o SOME; |
|
273 |
|
274 fun the_tactic context = |
|
275 (case snd (Data.get context) of |
|
276 SOME tac => tac |
|
277 | NONE => raise Fail "Undefined ML tactic"); |
259 |
278 |
260 fun ml_tactic source ctxt = |
279 fun ml_tactic source ctxt = |
261 let |
280 let |
262 val ctxt' = ctxt |> Context.proof_map |
281 val context = Context.Proof ctxt |
|
282 val context' = context |> |
263 (ML_Context.expression (#pos source) |
283 (ML_Context.expression (#pos source) |
264 "fun tactic (facts: thm list) : tactic" |
284 "fun tactic (facts: thm list) : tactic" |
265 "Context.map_proof (Method.set_tactic tactic)" (ML_Lex.read_source false source)); |
285 "Method.set_tactic tactic" (ML_Lex.read_source false source)); |
266 in Context.setmp_thread_data (SOME (Context.Proof ctxt)) (ML_Tactic.get ctxt') end; |
286 in Context.setmp_thread_data (SOME context) (the_tactic context') end; |
267 |
287 |
268 fun tactic source ctxt = METHOD (ml_tactic source ctxt); |
288 fun tactic source ctxt = METHOD (ml_tactic source ctxt); |
269 fun raw_tactic source ctxt = NO_CASES o ml_tactic source ctxt; |
289 fun raw_tactic source ctxt = NO_CASES o ml_tactic source ctxt; |
270 |
290 |
271 |
|
272 |
|
273 (** method syntax **) |
|
274 |
291 |
275 (* method text *) |
292 (* method text *) |
276 |
293 |
277 datatype combinator_info = Combinator_Info of {keywords: Position.T list}; |
294 datatype combinator_info = Combinator_Info of {keywords: Position.T list}; |
278 fun combinator_info keywords = Combinator_Info {keywords = keywords}; |
295 fun combinator_info keywords = Combinator_Info {keywords = keywords}; |
301 Combinator (no_combinator_info, Then, [txt, Basic (finish immed)]); |
318 Combinator (no_combinator_info, Then, [txt, Basic (finish immed)]); |
302 |
319 |
303 |
320 |
304 (* method definitions *) |
321 (* method definitions *) |
305 |
322 |
306 structure Methods = Generic_Data |
|
307 ( |
|
308 type T = ((Token.src -> Proof.context -> method) * string) Name_Space.table; |
|
309 val empty : T = Name_Space.empty_table "method"; |
|
310 val extend = I; |
|
311 fun merge data : T = Name_Space.merge_tables data; |
|
312 ); |
|
313 |
|
314 val get_methods = Methods.get o Context.Proof; |
|
315 |
|
316 fun transfer_methods ctxt = |
323 fun transfer_methods ctxt = |
317 let |
324 let |
318 val meths0 = Methods.get (Context.Theory (Proof_Context.theory_of ctxt)); |
325 val meths0 = get_methods (Context.Theory (Proof_Context.theory_of ctxt)); |
319 val meths' = Name_Space.merge_tables (meths0, get_methods ctxt); |
326 val meths' = Name_Space.merge_tables (meths0, get_methods (Context.Proof ctxt)); |
320 in Context.proof_map (Methods.put meths') ctxt end; |
327 in Context.proof_map (map_methods (K meths')) ctxt end; |
321 |
328 |
322 fun print_methods ctxt = |
329 fun print_methods ctxt = |
323 let |
330 let |
324 val meths = get_methods ctxt; |
331 val meths = get_methods (Context.Proof ctxt); |
325 fun prt_meth (name, (_, "")) = Pretty.mark_str name |
332 fun prt_meth (name, (_, "")) = Pretty.mark_str name |
326 | prt_meth (name, (_, comment)) = |
333 | prt_meth (name, (_, comment)) = |
327 Pretty.block |
334 Pretty.block |
328 (Pretty.mark_str name :: Pretty.str ":" :: Pretty.brk 2 :: Pretty.text comment); |
335 (Pretty.mark_str name :: Pretty.str ":" :: Pretty.brk 2 :: Pretty.text comment); |
329 in |
336 in |
336 |
343 |
337 fun define_global binding meth comment thy = |
344 fun define_global binding meth comment thy = |
338 let |
345 let |
339 val context = Context.Theory thy; |
346 val context = Context.Theory thy; |
340 val (name, meths') = |
347 val (name, meths') = |
341 Name_Space.define context true (binding, (meth, comment)) (Methods.get context); |
348 Name_Space.define context true (binding, (meth, comment)) (get_methods context); |
342 in (name, Context.the_theory (Methods.put meths' context)) end; |
349 in (name, Context.the_theory (map_methods (K meths') context)) end; |
343 |
350 |
344 fun define binding meth comment = |
351 fun define binding meth comment = |
345 Local_Theory.background_theory_result (define_global binding meth comment) |
352 Local_Theory.background_theory_result (define_global binding meth comment) |
346 #-> (fn name => |
353 #-> (fn name => |
347 Local_Theory.map_contexts (K transfer_methods) |
354 Local_Theory.map_contexts (K transfer_methods) |
348 #> Local_Theory.generic_alias Methods.map binding name |
355 #> Local_Theory.generic_alias map_methods binding name |
349 #> pair name); |
356 #> pair name); |
350 |
357 |
351 |
358 |
352 (* check *) |
359 (* check *) |
353 |
360 |
354 fun check_name ctxt = #1 o Name_Space.check (Context.Proof ctxt) (get_methods ctxt); |
361 fun check_name ctxt = |
355 fun check_src ctxt src = Token.check_src ctxt (get_methods ctxt) src; |
362 let val context = Context.Proof ctxt |
|
363 in #1 o Name_Space.check context (get_methods context) end; |
|
364 |
|
365 fun check_src ctxt src = |
|
366 Token.check_src ctxt (get_methods (Context.Proof ctxt)) src; |
356 |
367 |
357 |
368 |
358 (* method setup *) |
369 (* method setup *) |
359 |
370 |
360 fun method_syntax scan src ctxt : method = |
371 fun method_syntax scan src ctxt : method = |
374 |
385 |
375 |
386 |
376 (* prepare methods *) |
387 (* prepare methods *) |
377 |
388 |
378 fun method ctxt = |
389 fun method ctxt = |
379 let val table = get_methods ctxt |
390 let val table = get_methods (Context.Proof ctxt) |
380 in fn src => #1 (Name_Space.get table (#1 (Token.name_of_src src))) src end; |
391 in fn src => #1 (Name_Space.get table (#1 (Token.name_of_src src))) src end; |
381 |
392 |
382 fun method_closure ctxt0 src0 = |
393 fun method_closure ctxt0 src0 = |
383 let |
394 let |
384 val (src1, meth) = check_src ctxt0 src0; |
395 val (src1, meth) = check_src ctxt0 src0; |