149 facts: thm list option, |
149 facts: thm list option, |
150 mode: mode, |
150 mode: mode, |
151 goal: goal option} |
151 goal: goal option} |
152 and goal = |
152 and goal = |
153 Goal of |
153 Goal of |
154 {statement: (string * Position.T) * term list list * term, |
154 {statement: bool * (string * Position.T) * term list list * term, |
155 (*goal kind and statement (starting with vars), initial proposition*) |
155 (*regular export, goal kind and statement (starting with vars), initial proposition*) |
156 using: thm list, (*goal facts*) |
156 using: thm list, (*goal facts*) |
157 goal: thm, (*subgoals ==> statement*) |
157 goal: thm, (*subgoals ==> statement*) |
158 before_qed: Method.text option, |
158 before_qed: Method.text option, |
159 after_qed: |
159 after_qed: |
160 (thm list list -> state -> state) * |
160 (thm list list -> state -> state) * |
929 val goal_propss = filter_out null propss'; |
929 val goal_propss = filter_out null propss'; |
930 val goal = |
930 val goal = |
931 Logic.mk_conjunction_balanced (map Logic.mk_conjunction_balanced goal_propss) |
931 Logic.mk_conjunction_balanced (map Logic.mk_conjunction_balanced goal_propss) |
932 |> Thm.cterm_of goal_ctxt |
932 |> Thm.cterm_of goal_ctxt |
933 |> Thm.weaken_sorts (Variable.sorts_of goal_ctxt); |
933 |> Thm.weaken_sorts (Variable.sorts_of goal_ctxt); |
934 val statement = ((kind, pos), propss', Thm.term_of goal); |
934 val statement = (true, (kind, pos), propss', Thm.term_of goal); |
935 |
935 |
936 val after_qed' = after_qed |>> (fn after_local => fn results => |
936 val after_qed' = after_qed |>> (fn after_local => fn results => |
937 map_context (fold Variable.maybe_bind_term result_binds) #> after_local results); |
937 map_context (fold Variable.maybe_bind_term result_binds) #> after_local results); |
938 in |
938 in |
939 goal_state |
939 goal_state |
948 |> not (null vars) ? refine_terms (length goal_propss) |
948 |> not (null vars) ? refine_terms (length goal_propss) |
949 |> null props ? (refine (Method.Basic Method.assumption) #> Seq.hd) |
949 |> null props ? (refine (Method.Basic Method.assumption) #> Seq.hd) |
950 end; |
950 end; |
951 |
951 |
952 fun generic_qed state = |
952 fun generic_qed state = |
953 let val (goal_ctxt, {statement = (_, stmt, _), goal, after_qed, ...}) = current_goal state in |
953 let |
|
954 val (goal_ctxt, {statement, goal, after_qed, ...}) = current_goal state; |
|
955 val (regular_export, _, propss, _) = statement; |
|
956 in |
954 state |
957 state |
955 |> close_block |
958 |> close_block |
956 |> `(fn outer_state => |
959 |> `(fn outer_state => |
957 let |
960 let |
958 val results = |
961 val results = |
959 tl (conclude_goal goal_ctxt goal stmt) |
962 tl (conclude_goal goal_ctxt goal propss) |
960 |> burrow (Proof_Context.export goal_ctxt (context_of outer_state)); |
963 |> regular_export ? burrow (Proof_Context.export goal_ctxt (context_of outer_state)); |
961 in (after_qed, results) end) |
964 in (after_qed, results) end) |
962 end; |
965 end; |
963 |
966 |
964 end; |
967 end; |
965 |
968 |
1157 (** future proofs **) |
1160 (** future proofs **) |
1158 |
1161 |
1159 (* relevant proof states *) |
1162 (* relevant proof states *) |
1160 |
1163 |
1161 fun schematic_goal state = |
1164 fun schematic_goal state = |
1162 let val (_, (_, {statement = (_, _, prop), ...})) = find_goal state |
1165 let val (_, (_, {statement = (_, _, _, prop), ...})) = find_goal state |
1163 in Goal.is_schematic prop end; |
1166 in Goal.is_schematic prop end; |
1164 |
1167 |
1165 fun is_relevant state = |
1168 fun is_relevant state = |
1166 (case try find_goal state of |
1169 (case try find_goal state of |
1167 NONE => true |
1170 NONE => true |
1168 | SOME (_, (_, {statement = (_, _, prop), goal, ...})) => |
1171 | SOME (_, (_, {statement = (_, _, _, prop), goal, ...})) => |
1169 Goal.is_schematic prop orelse not (Logic.protect prop aconv Thm.concl_of goal)); |
1172 Goal.is_schematic prop orelse not (Logic.protect prop aconv Thm.concl_of goal)); |
1170 |
1173 |
1171 |
1174 |
1172 (* full proofs *) |
1175 (* full proofs *) |
1173 |
1176 |
1190 in |
1193 in |
1191 |
1194 |
1192 fun future_proof fork_proof state = |
1195 fun future_proof fork_proof state = |
1193 let |
1196 let |
1194 val _ = assert_backward state; |
1197 val _ = assert_backward state; |
1195 val (goal_ctxt, (_, goal)) = find_goal state; |
1198 val (goal_ctxt, (_, goal_info)) = find_goal state; |
1196 val {statement as (kind, _, prop), using, goal, before_qed, after_qed} = goal; |
1199 val {statement as (_, kind, _, prop), using, goal, before_qed, after_qed} = goal_info; |
1197 val goal_tfrees = |
|
1198 fold Term.add_tfrees |
|
1199 (prop :: map Thm.term_of (Assumption.all_assms_of goal_ctxt)) []; |
|
1200 |
1200 |
1201 val _ = is_relevant state andalso error "Cannot fork relevant proof"; |
1201 val _ = is_relevant state andalso error "Cannot fork relevant proof"; |
1202 |
1202 |
1203 val prop' = Logic.protect prop; |
1203 val prop' = Logic.protect prop; |
1204 val statement' = (kind, [[], [prop']], prop'); |
1204 val statement' = (false, kind, [[], [prop']], prop'); |
1205 val goal' = Thm.adjust_maxidx_thm (Thm.maxidx_of goal) (Goal.protect (Thm.nprems_of goal) goal); |
1205 val goal' = Thm.adjust_maxidx_thm (Thm.maxidx_of goal) (Goal.protect (Thm.nprems_of goal) goal); |
1206 val after_qed' = (fn [[th]] => map_context (set_result th), fn [[th]] => set_result th); |
1206 val after_qed' = (fn [[th]] => map_context (set_result th), fn [[th]] => set_result th); |
1207 |
1207 |
1208 val result_ctxt = |
1208 val result_ctxt = |
1209 state |
1209 state |
1210 |> map_context reset_result |
1210 |> map_context reset_result |
1211 |> map_goal I (K (statement', using, goal', before_qed, after_qed')) |
1211 |> map_goal I (K (statement', using, goal', before_qed, after_qed')) I |
1212 (fold (Variable.declare_typ o TFree) goal_tfrees) |
|
1213 |> fork_proof; |
1212 |> fork_proof; |
1214 |
1213 |
1215 val future_thm = Future.map (the_result o snd) result_ctxt; |
1214 val future_thm = Future.map (the_result o snd) result_ctxt; |
1216 val finished_goal = Goal.future_result goal_ctxt future_thm prop'; |
1215 val finished_goal = Goal.future_result goal_ctxt future_thm prop'; |
1217 val state' = |
1216 val state' = |