export setmp_thread_position;
authorwenzelm
Tue, 30 Sep 2008 14:19:26 +0200
changeset 28425 25d6099179a6
parent 28424 fc6ce1c4d5b7
child 28426 5bad734625ef
export setmp_thread_position; commit_exit: position; added plain command execution; simplified command_excursion, eliminated old (present_)excursion;
src/Pure/Isar/toplevel.ML
--- a/src/Pure/Isar/toplevel.ML	Tue Sep 30 14:19:25 2008 +0200
+++ b/src/Pure/Isar/toplevel.ML	Tue Sep 30 14:19:26 2008 +0200
@@ -87,13 +87,14 @@
   val unknown_theory: transition -> transition
   val unknown_proof: transition -> transition
   val unknown_context: transition -> transition
+  val setmp_thread_position: transition -> ('a -> 'b) -> 'a -> 'b
   val status: transition -> Markup.T -> unit
   val error_msg: transition -> exn * string -> unit
   val add_hook: (transition -> state -> state -> unit) -> unit
   val transition: bool -> transition -> state -> (state * (exn * string) option) option
-  val commit_exit: transition
-  val excursion: transition list -> unit
-  val present_excursion: (transition * (state -> state -> 'a -> 'a)) list -> 'a -> 'a
+  val commit_exit: Position.T -> transition
+  val command: transition -> state -> state
+  val command_excursion: transition list -> state list * (unit -> unit)
 end;
 
 structure Toplevel: TOPLEVEL =
@@ -667,39 +668,30 @@
 
 (* commit final exit *)
 
-val commit_exit =
+fun commit_exit pos =
   name "end" empty
+  |> position pos
   |> add_trans CommitExit
   |> imperative (fn () => warning "Expected to find finished theory");
 
 
-(* excursion: toplevel -- apply transformers/presentation -- toplevel *)
-
-local
-
-fun no_pr _ _ _ = ();
+(* nested commands *)
 
-fun excur (tr, pr) (st, res) =
+fun command tr st =
   (case transition (! interact) tr st of
-    SOME (st', NONE) =>
-      (st', setmp_thread_position tr (fn () => pr st st' res) () handle exn =>
-        raise EXCURSION_FAIL (exn, "Presentation failed\n" ^ at_command tr))
-  | SOME (st', SOME exn_info) => raise EXCURSION_FAIL exn_info
+    SOME (st', NONE) => st'
+  | SOME (_, SOME exn_info) => raise EXCURSION_FAIL exn_info
   | NONE => raise EXCURSION_FAIL (TERMINATE, at_command tr));
 
-fun excurs trs st_res =
-  let val (st', res') = fold excur trs st_res in
-    if is_toplevel st' then (excur (commit_exit, no_pr) (st', ()); res')
-    else error "Unfinished development at end of input"
-  end;
+fun command_result tr st =
+  let val st' = command tr st
+  in (st', st') end;
 
-in
-
-fun present_excursion trs res =
-  excurs trs (toplevel, res) handle exn => error (exn_message exn);
-
-fun excursion trs = present_excursion (map (rpair no_pr) trs) ();
+fun command_excursion trs =
+  let
+    val end_pos = if null trs then error "No commands" else pos_of (List.last trs);
+    val (command_results, end_state) = fold_map command_result trs toplevel;
+    val _ = is_toplevel end_state orelse error "Unfinished development at end of input";
+  in (command_results, fn () => ignore (command (commit_exit end_pos) end_state)) end;
 
 end;
-
-end;