112 ((Name.binding * attribute list) * (term * term list) list) list -> bool -> state -> state |
112 ((Name.binding * attribute list) * (term * term list) list) list -> bool -> state -> state |
113 val show: Method.text option -> (thm list list -> state -> state Seq.seq) -> |
113 val show: Method.text option -> (thm list list -> state -> state Seq.seq) -> |
114 (Attrib.binding * (string * string list) list) list -> bool -> state -> state |
114 (Attrib.binding * (string * string list) list) list -> bool -> state -> state |
115 val show_i: Method.text option -> (thm list list -> state -> state Seq.seq) -> |
115 val show_i: Method.text option -> (thm list list -> state -> state Seq.seq) -> |
116 ((Name.binding * attribute list) * (term * term list) list) list -> bool -> state -> state |
116 ((Name.binding * attribute list) * (term * term list) list) list -> bool -> state -> state |
|
117 val can_promise: state -> bool |
|
118 val promise_proof: (state -> context) -> state -> context |
117 end; |
119 end; |
118 |
120 |
119 structure Proof: PROOF = |
121 structure Proof: PROOF = |
120 struct |
122 struct |
121 |
123 |
137 facts: thm list option, |
139 facts: thm list option, |
138 mode: mode, |
140 mode: mode, |
139 goal: goal option} |
141 goal: goal option} |
140 and goal = |
142 and goal = |
141 Goal of |
143 Goal of |
142 {statement: (string * Position.T) * term list list, |
144 {statement: (string * Position.T) * term list list * cterm, |
143 (*goal kind and statement (starting with vars)*) |
145 (*goal kind and statement (starting with vars), initial proposition*) |
144 messages: (unit -> Pretty.T) list, (*persistent messages (hints etc.)*) |
146 messages: (unit -> Pretty.T) list, (*persistent messages (hints etc.)*) |
145 using: thm list, (*goal facts*) |
147 using: thm list, (*goal facts*) |
146 goal: thm, (*subgoals ==> statement*) |
148 goal: thm, (*subgoals ==> statement*) |
147 before_qed: Method.text option, |
149 before_qed: Method.text option, |
148 after_qed: |
150 after_qed: |
309 fun get_goal state = |
311 fun get_goal state = |
310 let val (ctxt, (_, {using, goal, ...})) = find_goal state |
312 let val (ctxt, (_, {using, goal, ...})) = find_goal state |
311 in (ctxt, (using, goal)) end; |
313 in (ctxt, (using, goal)) end; |
312 |
314 |
313 fun schematic_goal state = |
315 fun schematic_goal state = |
314 let val (_, (_, {statement = (_, propss), ...})) = find_goal state in |
316 let val (_, (_, {statement = (_, _, prop), ...})) = find_goal state in |
315 exists (exists (Term.exists_subterm Term.is_Var)) propss orelse |
317 Term.exists_subterm Term.is_Var (Thm.term_of prop) orelse |
316 exists (exists (Term.exists_type (Term.exists_subtype Term.is_TVar))) propss |
318 Term.exists_type (Term.exists_subtype Term.is_TVar) (Thm.term_of prop) |
317 end; |
319 end; |
318 |
320 |
319 |
321 |
320 |
322 |
321 (** pretty_state **) |
323 (** pretty_state **) |
344 fun description strs = |
346 fun description strs = |
345 (case filter_out (fn s => s = "") strs of [] => "" |
347 (case filter_out (fn s => s = "") strs of [] => "" |
346 | strs' => enclose " (" ")" (commas strs')); |
348 | strs' => enclose " (" ")" (commas strs')); |
347 |
349 |
348 fun prt_goal (SOME (ctxt, (i, |
350 fun prt_goal (SOME (ctxt, (i, |
349 {statement = ((_, pos), _), messages, using, goal, before_qed, after_qed}))) = |
351 {statement = ((_, pos), _, _), messages, using, goal, before_qed, after_qed}))) = |
350 pretty_facts "using " ctxt |
352 pretty_facts "using " ctxt |
351 (if mode <> Backward orelse null using then NONE else SOME using) @ |
353 (if mode <> Backward orelse null using then NONE else SOME using) @ |
352 [Pretty.str ("goal" ^ |
354 [Pretty.str ("goal" ^ |
353 description [levels_up (i div 2), subgoals (Thm.nprems_of goal)] ^ ":")] @ |
355 description [levels_up (i div 2), subgoals (Thm.nprems_of goal)] ^ ":")] @ |
354 pretty_goals_local ctxt Markup.subgoal |
356 pretty_goals_local ctxt Markup.subgoal |
803 implicit_vars (dest_TVar o Logic.dest_type o Logic.dest_term) Term.add_tvars props; |
805 implicit_vars (dest_TVar o Logic.dest_type o Logic.dest_term) Term.add_tvars props; |
804 val (vars, _) = implicit_vars (dest_Var o Logic.dest_term) Term.add_vars props'; |
806 val (vars, _) = implicit_vars (dest_Var o Logic.dest_term) Term.add_vars props'; |
805 |
807 |
806 val propss' = map (Logic.mk_term o Var) vars :: propss; |
808 val propss' = map (Logic.mk_term o Var) vars :: propss; |
807 val goal_propss = filter_out null propss'; |
809 val goal_propss = filter_out null propss'; |
808 val goal = Goal.init (cert |
810 val goal = cert (Logic.mk_conjunction_balanced (map Logic.mk_conjunction_balanced goal_propss)); |
809 (Logic.mk_conjunction_balanced (map Logic.mk_conjunction_balanced goal_propss))); |
811 val statement = ((kind, pos), propss', goal); |
810 val after_qed' = after_qed |>> (fn after_local => |
812 val after_qed' = after_qed |>> (fn after_local => |
811 fn results => map_context after_ctxt #> after_local results); |
813 fn results => map_context after_ctxt #> after_local results); |
812 in |
814 in |
813 goal_state |
815 goal_state |
814 |> map_context (init_context #> Variable.set_body true) |
816 |> map_context (init_context #> Variable.set_body true) |
815 |> put_goal (SOME (make_goal (((kind, pos), propss'), [], [], goal, before_qed, after_qed'))) |
817 |> put_goal (SOME (make_goal (statement, [], [], Goal.init goal, before_qed, after_qed'))) |
816 |> map_context (ProofContext.auto_bind_goal props) |
818 |> map_context (ProofContext.auto_bind_goal props) |
817 |> chaining ? (`the_facts #-> using_facts) |
819 |> chaining ? (`the_facts #-> using_facts) |
818 |> put_facts NONE |
820 |> put_facts NONE |
819 |> open_block |
821 |> open_block |
820 |> put_goal NONE |
822 |> put_goal NONE |
827 let |
829 let |
828 val (goal_ctxt, {statement, goal, after_qed, ...}) = current_goal state; |
830 val (goal_ctxt, {statement, goal, after_qed, ...}) = current_goal state; |
829 val outer_state = state |> close_block; |
831 val outer_state = state |> close_block; |
830 val outer_ctxt = context_of outer_state; |
832 val outer_ctxt = context_of outer_state; |
831 |
833 |
832 val ((_, pos), stmt) = statement; |
834 val ((_, pos), stmt, _) = statement; |
833 val props = |
835 val props = |
834 flat (tl stmt) |
836 flat (tl stmt) |
835 |> Variable.exportT_terms goal_ctxt outer_ctxt; |
837 |> Variable.exportT_terms goal_ctxt outer_ctxt; |
836 val results = |
838 val results = |
837 tl (conclude_goal state goal stmt) |
839 tl (conclude_goal state goal stmt) |
971 val show = gen_show Attrib.attribute ProofContext.bind_propp; |
973 val show = gen_show Attrib.attribute ProofContext.bind_propp; |
972 val show_i = gen_show (K I) ProofContext.bind_propp_i; |
974 val show_i = gen_show (K I) ProofContext.bind_propp_i; |
973 |
975 |
974 end; |
976 end; |
975 |
977 |
976 end; |
978 |
|
979 (* promise global proofs *) |
|
980 |
|
981 fun is_initial state = |
|
982 (case try find_goal state of |
|
983 NONE => false |
|
984 | SOME (_, (_, {statement = (_, _, prop), goal, ...})) => Thm.eq_thm_prop (Goal.init prop, goal)); |
|
985 |
|
986 fun can_promise state = |
|
987 can (assert_bottom true) state andalso |
|
988 can assert_backward state andalso |
|
989 is_initial state andalso |
|
990 not (schematic_goal state); |
|
991 |
|
992 fun promise_proof make_proof state = |
|
993 let |
|
994 val _ = can_promise state orelse error "Cannot promise proof"; |
|
995 |
|
996 val (goal_ctxt, (_, goal)) = find_goal state; |
|
997 val {statement as (kind, propss, cprop), messages, using, goal, before_qed, after_qed} = goal; |
|
998 val prop = Thm.term_of cprop; |
|
999 |
|
1000 val statement' = (kind, [[prop]], cprop); |
|
1001 fun after_qed' [[th]] = ProofContext.put_thms false (AutoBind.thisN, SOME [th]); |
|
1002 val this_name = ProofContext.full_name (ProofContext.reset_naming goal_ctxt) AutoBind.thisN; |
|
1003 |
|
1004 fun make_result () = state |
|
1005 |> map_goal I (K (statement', messages, using, goal, before_qed, (#1 after_qed, after_qed'))) |
|
1006 |> make_proof |
|
1007 |> (fn result_ctxt => ProofContext.get_fact_single result_ctxt (Facts.named this_name)); |
|
1008 val finished_goal = Goal.protect (Goal.promise_result goal_ctxt make_result prop); |
|
1009 in |
|
1010 state |
|
1011 |> map_goal I (K (statement, messages, using, finished_goal, NONE, after_qed)) |
|
1012 |> global_done_proof |
|
1013 end; |
|
1014 |
|
1015 end; |