src/Pure/Isar/proof.ML
changeset 5936 406eb27fe53c
parent 5918 4cbd726577f7
child 5945 63184e276c1d
equal deleted inserted replaced
5935:6a82c8a1808f 5936:406eb27fe53c
    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