# HG changeset patch # User wenzelm # Date 1278189190 -7200 # Node ID e07dacec79e75c062d8a5a51ae3a33ed47b6a128 # Parent bb27d99a9a693f3e795f2aaac5ae667b64c33b7c Toplevel.run_command: asynchronous state output, as an attempt to address potentially slow pretty printing (e.g. in HOL/Bali); diff -r bb27d99a9a69 -r e07dacec79e7 src/Pure/Isar/toplevel.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 *) diff -r bb27d99a9a69 -r e07dacec79e7 src/Pure/System/isabelle_process.ML --- 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});