33 val method: (tthm list -> thm -> |
33 val method: (tthm list -> thm -> |
34 (thm * (indexname * term) list * (string * tthm list) list) Seq.seq) -> method |
34 (thm * (indexname * term) list * (string * tthm list) list) Seq.seq) -> method |
35 val refine: (context -> method) -> state -> state Seq.seq |
35 val refine: (context -> method) -> state -> state Seq.seq |
36 val bind: (indexname * string) list -> state -> state |
36 val bind: (indexname * string) list -> state -> state |
37 val bind_i: (indexname * term) list -> state -> state |
37 val bind_i: (indexname * term) list -> state -> state |
38 val match_bind: (string * string) list -> state -> state |
38 val match_bind: (string list * string) list -> state -> state |
39 val match_bind_i: (term * term) list -> state -> state |
39 val match_bind_i: (term list * term) list -> state -> state |
40 val have_tthmss: string -> context attribute list -> |
40 val have_tthmss: string -> context attribute list -> |
41 (tthm list * context attribute list) list -> state -> state |
41 (tthm list * context attribute list) list -> state -> state |
42 val assume: string -> context attribute list -> string list -> state -> state |
42 val assume: string -> context attribute list -> (string * string list) list -> state -> state |
43 val assume_i: string -> context attribute list -> term list -> state -> state |
43 val assume_i: string -> context attribute list -> (term * term list) list -> state -> state |
44 val fix: (string * string option) list -> state -> state |
44 val fix: (string * string option) list -> state -> state |
45 val fix_i: (string * typ) list -> state -> state |
45 val fix_i: (string * typ) list -> state -> state |
46 val theorem: bstring -> theory attribute list -> string -> theory -> state |
46 val theorem: bstring -> theory attribute list -> string * string list -> theory -> state |
47 val theorem_i: bstring -> theory attribute list -> term -> theory -> state |
47 val theorem_i: bstring -> theory attribute list -> term * term list -> theory -> state |
48 val lemma: bstring -> theory attribute list -> string -> theory -> state |
48 val lemma: bstring -> theory attribute list -> string * string list -> theory -> state |
49 val lemma_i: bstring -> theory attribute list -> term -> theory -> state |
49 val lemma_i: bstring -> theory attribute list -> term * term list -> theory -> state |
50 val chain: state -> state |
50 val chain: state -> state |
51 val from_facts: tthm list -> state -> state |
51 val from_facts: tthm list -> state -> state |
52 val show: string -> context attribute list -> string -> state -> state |
52 val show: string -> context attribute list -> string * string list -> state -> state |
53 val show_i: string -> context attribute list -> term -> state -> state |
53 val show_i: string -> context attribute list -> term * term list -> state -> state |
54 val have: string -> context attribute list -> string -> state -> state |
54 val have: string -> context attribute list -> string * string list -> state -> state |
55 val have_i: string -> context attribute list -> term -> state -> state |
55 val have_i: string -> context attribute list -> term * term list -> state -> state |
56 val begin_block: state -> state |
56 val begin_block: state -> state |
57 val next_block: state -> state |
57 val next_block: state -> state |
58 val end_block: (context -> method) -> state -> state Seq.seq |
58 val end_block: (context -> method) -> state -> state Seq.seq |
59 val qed: (context -> method) -> bstring option -> theory attribute list option -> state |
59 val qed: (context -> method) -> bstring option -> theory attribute list option -> state |
60 -> theory * (string * string * tthm) |
60 -> theory * (string * string * tthm) |
81 Theorem of theory attribute list | (*top-level theorem*) |
81 Theorem of theory attribute list | (*top-level theorem*) |
82 Lemma of theory attribute list | (*top-level lemma*) |
82 Lemma of theory attribute list | (*top-level lemma*) |
83 Goal of context attribute list | (*intermediate result, solving subgoal*) |
83 Goal of context attribute list | (*intermediate result, solving subgoal*) |
84 Aux of context attribute list ; (*intermediate result*) |
84 Aux of context attribute list ; (*intermediate result*) |
85 |
85 |
|
86 val theoremN = "theorem"; |
86 val kind_name = |
87 val kind_name = |
87 fn Theorem _ => "theorem" | Lemma _ => "lemma" | Goal _ => "show" | Aux _ => "have"; |
88 fn Theorem _ => theoremN | Lemma _ => "lemma" | Goal _ => "show" | Aux _ => "have"; |
88 |
89 |
89 type goal = |
90 type goal = |
90 (kind * (*result kind*) |
91 (kind * (*result kind*) |
91 string * (*result name*) |
92 string * (*result name*) |
92 cterm list * (*result assumptions*) |
93 cterm list * (*result assumptions*) |
478 |> chain; |
479 |> chain; |
479 |
480 |
480 |
481 |
481 (* setup goals *) |
482 (* setup goals *) |
482 |
483 |
483 val read_prop = ProofContext.read_prop o context_of; |
484 fun setup_goal opt_block prepp kind name atts raw_propp state = |
484 val cert_prop = ProofContext.cert_prop o context_of; |
485 let |
485 |
486 val (state', concl) = |
486 fun setup_goal opt_block prep kind name atts raw_prop state = |
487 state |
487 let |
488 |> assert_forward_or_chain |
488 val sign = sign_of state; |
489 |> enter_forward |
489 val ctxt = context_of state; |
490 |> opt_block |
490 |
491 |> map_context_result (fn c => prepp (c, raw_propp)); |
491 val casms = map (#prop o Thm.crep_thm o Attribute.thm_of) (ProofContext.assumptions ctxt); |
492 |
|
493 val casms = map (#prop o Thm.crep_thm o Attribute.thm_of) |
|
494 (ProofContext.assumptions (context_of state')); |
492 val asms = map Thm.term_of casms; |
495 val asms = map Thm.term_of casms; |
493 |
496 |
494 val prop = Logic.list_implies (asms, prep state raw_prop); |
497 val prop = Logic.list_implies (asms, concl); |
495 val cprop = Thm.cterm_of sign prop; |
498 val cprop = Thm.cterm_of (sign_of state') prop; |
496 val thm = Drule.mk_triv_goal cprop; |
499 val thm = Drule.mk_triv_goal cprop; |
497 in |
500 in |
498 state |
501 state' |
499 |> assert_forward_or_chain |
|
500 |> enter_forward |
|
501 |> opt_block |
|
502 |
|
503 |> declare_term prop |
|
504 |> put_goal (Some ((kind atts, (PureThy.default_name name), casms, prop), ([], thm))) |
502 |> put_goal (Some ((kind atts, (PureThy.default_name name), casms, prop), ([], thm))) |
505 |> bind_props [("thesis", prop)] |
503 |> bind_props [("thesis", prop)] |
506 |> (if is_chain state then use_facts else reset_facts) |
504 |> (if is_chain state then use_facts else reset_facts) |
507 |
|
508 |> new_block |
505 |> new_block |
509 |> enter_backward |
506 |> enter_backward |
510 end; |
507 end; |
511 |
508 |
512 |
509 |
513 (*global goals*) |
510 (*global goals*) |
514 fun global_goal prep kind name atts x thy = |
511 fun global_goal prep kind name atts x thy = |
515 setup_goal I prep kind name atts x (init_state thy); |
512 setup_goal I prep kind name atts x (init_state thy); |
516 |
513 |
517 val theorem = global_goal read_prop Theorem; |
514 val theorem = global_goal ProofContext.bind_propp Theorem; |
518 val theorem_i = global_goal cert_prop Theorem; |
515 val theorem_i = global_goal ProofContext.bind_propp_i Theorem; |
519 val lemma = global_goal read_prop Lemma; |
516 val lemma = global_goal ProofContext.bind_propp Lemma; |
520 val lemma_i = global_goal cert_prop Lemma; |
517 val lemma_i = global_goal ProofContext.bind_propp_i Lemma; |
521 |
518 |
522 |
519 |
523 (*local goals*) |
520 (*local goals*) |
524 fun local_goal prep kind name atts x = |
521 fun local_goal prep kind name atts x = |
525 setup_goal open_block prep kind name atts x; |
522 setup_goal open_block prep kind name atts x; |
526 |
523 |
527 val show = local_goal read_prop Goal; |
524 val show = local_goal ProofContext.bind_propp Goal; |
528 val show_i = local_goal cert_prop Goal; |
525 val show_i = local_goal ProofContext.bind_propp_i Goal; |
529 val have = local_goal read_prop Aux; |
526 val have = local_goal ProofContext.bind_propp Aux; |
530 val have_i = local_goal cert_prop Aux; |
527 val have_i = local_goal ProofContext.bind_propp_i Aux; |
531 |
528 |
532 |
529 |
533 |
530 |
534 (** blocks **) |
531 (** blocks **) |
535 |
532 |
631 Theorem atts => if_none alt_atts atts |
628 Theorem atts => if_none alt_atts atts |
632 | Lemma atts => (if_none alt_atts atts) @ [Attribute.tag_lemma] |
629 | Lemma atts => (if_none alt_atts atts) @ [Attribute.tag_lemma] |
633 | _ => raise STATE ("No global goal!", state)); |
630 | _ => raise STATE ("No global goal!", state)); |
634 |
631 |
635 val (thy', result') = PureThy.store_tthm ((name, (result, [])), atts) (theory_of state); |
632 val (thy', result') = PureThy.store_tthm ((name, (result, [])), atts) (theory_of state); |
636 in (thy', (kind_name kind, name, result')) end; |
633 in (thy', (theoremN, name, result')) end; |
637 |
634 |
638 fun qed meth_fun alt_name alt_atts state = |
635 fun qed meth_fun alt_name alt_atts state = |
639 state |
636 state |
640 |> finish_proof true meth_fun |
637 |> finish_proof true meth_fun |
641 |> Seq.hd |
638 |> Seq.hd |