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)) = |