Toplevel.run_command: asynchronous state output, as an attempt to address potentially slow pretty printing (e.g. in HOL/Bali);
authorwenzelm
Sat, 03 Jul 2010 22:33:10 +0200
changeset 37687 e07dacec79e7
parent 37686 bb27d99a9a69
child 37688 9f047b2cfc72
Toplevel.run_command: asynchronous state output, as an attempt to address potentially slow pretty printing (e.g. in HOL/Bali);
src/Pure/Isar/toplevel.ML
src/Pure/System/isabelle_process.ML
--- a/src/Pure/Isar/toplevel.ML	Sat Jul 03 20:36:30 2010 +0200
+++ b/src/Pure/Isar/toplevel.ML	Sat Jul 03 22:33:10 2010 +0200
@@ -86,9 +86,9 @@
   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 run_command: string -> transition -> state -> state option
   val commit_exit: Position.T -> transition
   val command: transition -> state -> state
-  val run_command: string -> transition -> state -> state option
   val excursion: (transition * transition list) list -> (transition * state) list lazy
 end;
 
@@ -561,6 +561,10 @@
 fun status tr m =
   setmp_thread_position tr (fn () => Output.status (Markup.markup m "")) ();
 
+fun async_state tr st =
+  Future.fork_group (Task_Queue.new_group (Future.worker_group ())) (fn () =>
+    setmp_thread_position tr (fn () => print_state false st) ());
+
 fun error_msg tr exn_info =
   setmp_thread_position tr (fn () =>
     Output.error_msg (ML_Compiler.exn_message (EXCURSION_FAIL exn_info))) ();
@@ -614,6 +618,22 @@
 end;
 
 
+(* managed execution *)
+
+fun run_command thy_name (tr as Transition {print, ...}) st =
+  (case
+      (case init_of tr of
+        SOME name => Exn.capture (fn () => Thy_Load.check_name thy_name name) ()
+      | NONE => Exn.Result ()) of
+    Exn.Result () =>
+      (case transition false tr st of
+        SOME (st', NONE) => (status tr Markup.finished; async_state tr st'; SOME st')
+      | SOME (_, SOME (exn as Exn.Interrupt, _)) => reraise exn
+      | SOME (_, SOME exn_info) => (error_msg tr exn_info; status tr Markup.failed; NONE)
+      | NONE => (error_msg tr (TERMINATE, at_command tr); status tr Markup.failed; NONE))
+  | Exn.Exn exn => (error_msg tr (exn, at_command tr); status tr Markup.failed; NONE));
+
+
 (* commit final exit *)
 
 fun commit_exit pos =
@@ -635,19 +655,6 @@
   let val st' = command tr st
   in (st', st') end;
 
-fun run_command thy_name tr st =
-  (case
-      (case init_of tr of
-        SOME name => Exn.capture (fn () => Thy_Load.check_name thy_name name) ()
-      | NONE => Exn.Result ()) of
-    Exn.Result () =>
-      (case transition true tr st of
-        SOME (st', NONE) => (status tr Markup.finished; SOME st')
-      | SOME (_, SOME (exn as Exn.Interrupt, _)) => reraise exn
-      | SOME (_, SOME exn_info) => (error_msg tr exn_info; status tr Markup.failed; NONE)
-      | NONE => (error_msg tr (TERMINATE, at_command tr); status tr Markup.failed; NONE))
-  | Exn.Exn exn => (error_msg tr (exn, at_command tr); status tr Markup.failed; NONE));
-
 
 (* excursion of units, consisting of commands with proof *)
 
--- a/src/Pure/System/isabelle_process.ML	Sat Jul 03 20:36:30 2010 +0200
+++ b/src/Pure/System/isabelle_process.ML	Sat Jul 03 22:33:10 2010 +0200
@@ -91,6 +91,7 @@
  (Unsynchronized.change print_mode
     (fold (update op =) [isabelle_processN, Keyword.keyword_status_reportN, Pretty.symbolicN]);
   setup_channels out |> init_message;
+  quick_and_dirty := true;  (* FIXME !? *)
   Keyword.report ();
   Output.status (Markup.markup Markup.ready "");
   Isar.toplevel_loop {init = true, welcome = false, sync = true, secure = true});