seal system channels at end of Pure bootstrap -- Isabelle/Scala provides official interfaces;
authorwenzelm
Mon, 10 Feb 2014 22:39:04 +0100
changeset 55387 51f0876f61df
parent 55386 0c15ac6edcf7
child 55388 bc34c5774f26
seal system channels at end of Pure bootstrap -- Isabelle/Scala provides official interfaces;
src/Pure/General/output.ML
src/Pure/ROOT.ML
src/Pure/System/isabelle_process.ML
src/Pure/System/isar.ML
src/Pure/Tools/build.ML
src/Pure/Tools/proof_general.ML
--- a/src/Pure/General/output.ML	Mon Feb 10 22:22:06 2014 +0100
+++ b/src/Pure/General/output.ML	Mon Feb 10 22:39:04 2014 +0100
@@ -25,19 +25,6 @@
   val physical_stderr: output -> unit
   val physical_writeln: output -> unit
   exception Protocol_Message of Properties.T
-  structure Internal:
-  sig
-    val writeln_fn: (output -> unit) Unsynchronized.ref
-    val urgent_message_fn: (output -> unit) Unsynchronized.ref
-    val tracing_fn: (output -> unit) Unsynchronized.ref
-    val warning_fn: (output -> unit) Unsynchronized.ref
-    val error_message_fn: (serial * output -> unit) Unsynchronized.ref
-    val prompt_fn: (output -> unit) Unsynchronized.ref
-    val status_fn: (output -> unit) Unsynchronized.ref
-    val report_fn: (output -> unit) Unsynchronized.ref
-    val result_fn: (Properties.T -> output -> unit) Unsynchronized.ref
-    val protocol_message_fn: (Properties.T -> output -> unit) Unsynchronized.ref
-  end
   val urgent_message: string -> unit
   val error_message': serial * string -> unit
   val error_message: string -> unit
@@ -49,7 +36,22 @@
   val try_protocol_message: Properties.T -> string -> unit
 end;
 
-structure Output: OUTPUT =
+signature PRIVATE_OUTPUT =
+sig
+  include OUTPUT
+  val writeln_fn: (output -> unit) Unsynchronized.ref
+  val urgent_message_fn: (output -> unit) Unsynchronized.ref
+  val tracing_fn: (output -> unit) Unsynchronized.ref
+  val warning_fn: (output -> unit) Unsynchronized.ref
+  val error_message_fn: (serial * output -> unit) Unsynchronized.ref
+  val prompt_fn: (output -> unit) Unsynchronized.ref
+  val status_fn: (output -> unit) Unsynchronized.ref
+  val report_fn: (output -> unit) Unsynchronized.ref
+  val result_fn: (Properties.T -> output -> unit) Unsynchronized.ref
+  val protocol_message_fn: (Properties.T -> output -> unit) Unsynchronized.ref
+end;
+
+structure Output: PRIVATE_OUTPUT =
 struct
 
 (** print modes **)
@@ -92,33 +94,30 @@
 
 exception Protocol_Message of Properties.T;
 
-structure Internal =
-struct
-  val writeln_fn = Unsynchronized.ref physical_writeln;
-  val urgent_message_fn = Unsynchronized.ref (fn s => ! writeln_fn s);  (*Proof General legacy*)
-  val tracing_fn = Unsynchronized.ref (fn s => ! writeln_fn s);
-  val warning_fn = Unsynchronized.ref (physical_writeln o prefix_lines "### ");
-  val error_message_fn =
-    Unsynchronized.ref (fn (_: serial, s) => physical_writeln (prefix_lines "*** " s));
-  val prompt_fn = Unsynchronized.ref physical_stdout;
-  val status_fn = Unsynchronized.ref (fn _: output => ());
-  val report_fn = Unsynchronized.ref (fn _: output => ());
-  val result_fn = Unsynchronized.ref (fn _: Properties.T => fn _: output => ());
-  val protocol_message_fn: (Properties.T -> output -> unit) Unsynchronized.ref =
-    Unsynchronized.ref (fn props => fn _ => raise Protocol_Message props);
-end;
+val writeln_fn = Unsynchronized.ref physical_writeln;
+val urgent_message_fn = Unsynchronized.ref (fn s => ! writeln_fn s);  (*Proof General legacy*)
+val tracing_fn = Unsynchronized.ref (fn s => ! writeln_fn s);
+val warning_fn = Unsynchronized.ref (physical_writeln o prefix_lines "### ");
+val error_message_fn =
+  Unsynchronized.ref (fn (_: serial, s) => physical_writeln (prefix_lines "*** " s));
+val prompt_fn = Unsynchronized.ref physical_stdout;
+val status_fn = Unsynchronized.ref (fn _: output => ());
+val report_fn = Unsynchronized.ref (fn _: output => ());
+val result_fn = Unsynchronized.ref (fn _: Properties.T => fn _: output => ());
+val protocol_message_fn: (Properties.T -> output -> unit) Unsynchronized.ref =
+  Unsynchronized.ref (fn props => fn _ => raise Protocol_Message props);
 
-fun writeln s = ! Internal.writeln_fn (output s);
-fun urgent_message s = ! Internal.urgent_message_fn (output s);  (*Proof General legacy*)
-fun tracing s = ! Internal.tracing_fn (output s);
-fun warning s = ! Internal.warning_fn (output s);
-fun error_message' (i, s) = ! Internal.error_message_fn (i, output s);
+fun writeln s = ! writeln_fn (output s);
+fun urgent_message s = ! urgent_message_fn (output s);  (*Proof General legacy*)
+fun tracing s = ! tracing_fn (output s);
+fun warning s = ! warning_fn (output s);
+fun error_message' (i, s) = ! error_message_fn (i, output s);
 fun error_message s = error_message' (serial (), s);
-fun prompt s = ! Internal.prompt_fn (output s);
-fun status s = ! Internal.status_fn (output s);
-fun report s = ! Internal.report_fn (output s);
-fun result props s = ! Internal.result_fn props (output s);
-fun protocol_message props s = ! Internal.protocol_message_fn props (output s);
+fun prompt s = ! prompt_fn (output s);
+fun status s = ! status_fn (output s);
+fun report s = ! report_fn (output s);
+fun result props s = ! result_fn props (output s);
+fun protocol_message props s = ! protocol_message_fn props (output s);
 fun try_protocol_message props s = protocol_message props s handle Protocol_Message _ => ();
 
 end;
--- a/src/Pure/ROOT.ML	Mon Feb 10 22:22:06 2014 +0100
+++ b/src/Pure/ROOT.ML	Mon Feb 10 22:39:04 2014 +0100
@@ -306,6 +306,8 @@
 use "Tools/named_thms.ML";
 use "Tools/proof_general.ML";
 
+structure Output: OUTPUT = Output;  (*seal system channels!*)
+
 
 (* ML toplevel pretty printing *)
 
--- a/src/Pure/System/isabelle_process.ML	Mon Feb 10 22:22:06 2014 +0100
+++ b/src/Pure/System/isabelle_process.ML	Mon Feb 10 22:39:04 2014 +0100
@@ -111,19 +111,19 @@
         message name
           (fold_rev Properties.put props (Position.properties_of (Position.thread_data ()))) body;
   in
-    Output.Internal.status_fn := standard_message [] Markup.statusN;
-    Output.Internal.report_fn := standard_message [] Markup.reportN;
-    Output.Internal.result_fn :=
+    Output.status_fn := standard_message [] Markup.statusN;
+    Output.report_fn := standard_message [] Markup.reportN;
+    Output.result_fn :=
       (fn props => fn s => standard_message (props @ serial_props ()) Markup.resultN s);
-    Output.Internal.writeln_fn := (fn s => standard_message (serial_props ()) Markup.writelnN s);
-    Output.Internal.tracing_fn :=
+    Output.writeln_fn := (fn s => standard_message (serial_props ()) Markup.writelnN s);
+    Output.tracing_fn :=
       (fn s => (update_tracing (); standard_message (serial_props ()) Markup.tracingN s));
-    Output.Internal.warning_fn := (fn s => standard_message (serial_props ()) Markup.warningN s);
-    Output.Internal.error_message_fn :=
+    Output.warning_fn := (fn s => standard_message (serial_props ()) Markup.warningN s);
+    Output.error_message_fn :=
       (fn (i, s) => standard_message (Markup.serial_properties i) Markup.errorN s);
-    Output.Internal.protocol_message_fn := message Markup.protocolN;
-    Output.Internal.urgent_message_fn := ! Output.Internal.writeln_fn;
-    Output.Internal.prompt_fn := ignore;
+    Output.protocol_message_fn := message Markup.protocolN;
+    Output.urgent_message_fn := ! Output.writeln_fn;
+    Output.prompt_fn := ignore;
     message Markup.initN [] (Session.welcome ());
     msg_channel
   end;
--- a/src/Pure/System/isar.ML	Mon Feb 10 22:22:06 2014 +0100
+++ b/src/Pure/System/isar.ML	Mon Feb 10 22:39:04 2014 +0100
@@ -157,7 +157,7 @@
  (Context.set_thread_data NONE;
   Multithreading.max_threads_update (Options.default_int "threads");
   if do_init then init () else ();
-  Output.Internal.protocol_message_fn := protocol_message;
+  Output.protocol_message_fn := protocol_message;
   if welcome then writeln (Session.welcome ()) else ();
   uninterruptible (fn _ => fn () => raw_loop secure (Outer_Syntax.isar in_stream sync)) ());
 
--- a/src/Pure/Tools/build.ML	Mon Feb 10 22:22:06 2014 +0100
+++ b/src/Pure/Tools/build.ML	Mon Feb 10 22:39:04 2014 +0100
@@ -166,7 +166,7 @@
         theories |>
           (List.app (use_theories_condition last_timing)
             |> session_timing name verbose
-            |> Unsynchronized.setmp Output.Internal.protocol_message_fn protocol_message
+            |> Unsynchronized.setmp Output.protocol_message_fn protocol_message
             |> Multithreading.max_threads_setmp (Options.int options "threads")
             |> Exn.capture);
       val res2 = Exn.capture Session.finish ();
--- a/src/Pure/Tools/proof_general.ML	Mon Feb 10 22:22:06 2014 +0100
+++ b/src/Pure/Tools/proof_general.ML	Mon Feb 10 22:39:04 2014 +0100
@@ -264,14 +264,14 @@
   | s => Output.physical_writeln (enclose bg en (prefix_lines prfx s)));
 
 fun setup_messages () =
- (Output.Internal.writeln_fn := message "" "" "";
-  Output.Internal.status_fn := (fn _ => ());
-  Output.Internal.report_fn := (fn _ => ());
-  Output.Internal.urgent_message_fn := message (special "I") (special "J") "";
-  Output.Internal.tracing_fn := message (special "I" ^ special "V") (special "J") "";
-  Output.Internal.warning_fn := message (special "K") (special "L") "### ";
-  Output.Internal.error_message_fn := (fn (_, s) => message (special "M") (special "N") "*** " s);
-  Output.Internal.prompt_fn := (fn s => Output.physical_stdout (render s ^ special "S")));
+ (Output.writeln_fn := message "" "" "";
+  Output.status_fn := (fn _ => ());
+  Output.report_fn := (fn _ => ());
+  Output.urgent_message_fn := message (special "I") (special "J") "";
+  Output.tracing_fn := message (special "I" ^ special "V") (special "J") "";
+  Output.warning_fn := message (special "K") (special "L") "### ";
+  Output.error_message_fn := (fn (_, s) => message (special "M") (special "N") "*** " s);
+  Output.prompt_fn := (fn s => Output.physical_stdout (render s ^ special "S")));
 
 
 (* notification *)