src/Pure/Isar/proof.ML
changeset 60409 240ad53041c9
parent 60408 1fd46ced2fa8
child 60411 8f7e1279251d
equal deleted inserted replaced
60408:1fd46ced2fa8 60409:240ad53041c9
   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' =