src/Pure/Isar/toplevel.ML
changeset 26624 770265032999
parent 26621 78b3ad7af5d5
child 26982 de7738deadfb
equal deleted inserted replaced
26623:81547c8d51f8 26624:770265032999
   139   | presentation_context (SOME node) NONE = cases_node Context.proof_of Proof.context_of node
   139   | presentation_context (SOME node) NONE = cases_node Context.proof_of Proof.context_of node
   140   | presentation_context (SOME node) (SOME loc) =
   140   | presentation_context (SOME node) (SOME loc) =
   141       loc_init loc (cases_node Context.theory_of Proof.theory_of node)
   141       loc_init loc (cases_node Context.theory_of Proof.theory_of node)
   142   | presentation_context NONE _ = raise UNDEF;
   142   | presentation_context NONE _ = raise UNDEF;
   143 
   143 
       
   144 fun reset_presentation (Theory (gthy, _)) = Theory (gthy, NONE)
       
   145   | reset_presentation node = node;
       
   146 
   144 
   147 
   145 (* datatype state *)
   148 (* datatype state *)
   146 
   149 
   147 type state_info = node History.T * ((theory -> unit) * (theory -> unit));
   150 type state_info = node History.T * ((theory -> unit) * (theory -> unit));
   148 
   151 
   324 
   327 
   325 local
   328 local
   326 
   329 
   327 fun is_stale state = Context.is_stale (theory_of state) handle UNDEF => false;
   330 fun is_stale state = Context.is_stale (theory_of state) handle UNDEF => false;
   328 
   331 
   329 val stale_theory = ERROR "Stale theory encountered after successful execution!";
   332 fun is_draft_theory (Theory (gthy, _)) = Context.is_draft (Context.theory_of gthy)
       
   333   | is_draft_theory _ = false;
       
   334 
       
   335 fun stale_error NONE = SOME (ERROR "Stale theory encountered after successful execution!")
       
   336   | stale_error some = some;
   330 
   337 
   331 fun map_theory f = History.map_current
   338 fun map_theory f = History.map_current
   332   (fn Theory (gthy, _) => Theory (Context.mapping f (LocalTheory.raw_theory f) gthy, NONE)
   339   (fn Theory (gthy, ctxt) => Theory (Context.mapping f (LocalTheory.raw_theory f) gthy, ctxt)
   333     | node => node);
   340     | node => node);
   334 
       
   335 fun return (result, NONE) = result
       
   336   | return (result, SOME exn) = raise FAILURE (result, exn);
       
   337 
   341 
   338 in
   342 in
   339 
   343 
   340 fun transaction hist pos f (node, term) =
   344 fun transaction hist pos f (node, term) =
   341   let
   345   let
   342     val cont_node = map_theory Theory.checkpoint node;
   346     val _ = is_draft_theory (History.current node) andalso
   343     val back_node = map_theory Theory.copy cont_node;
   347       error "Illegal draft theory in toplevel state";
   344     fun state nd = State (nd, term);
   348     val cont_node = node |> History.map_current reset_presentation;
   345     fun normal_state nd = (state nd, NONE);
   349     val back_node = cont_node |> map_theory Theory.copy |> map_theory Theory.checkpoint;
   346     fun error_state nd exn = (state nd, SOME exn);
   350     fun state_error e nd = (State (nd, term), e);
   347 
   351 
   348     val (result, err) =
   352     val (result, err) =
   349       cont_node
   353       cont_node
   350       |> (f
   354       |> (f
   351           |> (if hist then History.apply' (History.current back_node) else History.map_current)
   355           |> (if hist then History.apply' (History.current back_node) else History.map_current)
   352           |> controlled_execution)
   356           |> controlled_execution)
   353       |> normal_state
   357       |> map_theory Theory.checkpoint
   354       handle exn => error_state cont_node exn;
   358       |> state_error NONE
       
   359       handle exn => state_error (SOME exn) cont_node;
       
   360 
       
   361     val (result', err') =
       
   362       if is_stale result then state_error (stale_error err) back_node
       
   363       else (result, err);
   355   in
   364   in
   356     if is_stale result
   365     (case err' of
   357     then return (error_state back_node (the_default stale_theory err))
   366       NONE => result'
   358     else return (result, err)
   367     | SOME exn => raise FAILURE (result', exn))
   359   end;
   368   end;
   360 
   369 
   361 end;
   370 end;
   362 
   371 
   363 
   372 
   390 local
   399 local
   391 
   400 
   392 fun keep_state int f = controlled_execution (fn x => tap (f int) x);
   401 fun keep_state int f = controlled_execution (fn x => tap (f int) x);
   393 
   402 
   394 fun apply_tr int _ (Init (f, term)) (state as Toplevel _) =
   403 fun apply_tr int _ (Init (f, term)) (state as Toplevel _) =
   395       let val node = Theory (Context.Theory (f int), NONE)
   404       let val node = Theory (Context.Theory (Theory.checkpoint (f int)), NONE)
   396       in safe_exit state; State (History.init (undo_limit int) node, term) end
   405       in safe_exit state; State (History.init (undo_limit int) node, term) end
   397   | apply_tr int _ (InitEmpty (check, f)) (state as Toplevel _) =
   406   | apply_tr int _ (InitEmpty (check, f)) (state as Toplevel _) =
   398       if check state then (safe_exit state; keep_state int (fn _ => fn _ => f ()) toplevel)
   407       if check state then (safe_exit state; keep_state int (fn _ => fn _ => f ()) toplevel)
   399       else raise UNDEF
   408       else raise UNDEF
   400   | apply_tr _ _ Exit (State (node, term)) =
   409   | apply_tr _ _ Exit (State (node, term)) =