support named ML environments, notably "Isabelle", "SML";
authorwenzelm
Mon, 27 Aug 2018 14:42:24 +0200
changeset 68816 5a53724fe247
parent 68815 6296915dee6e
child 68817 b9568a82b474
support named ML environments, notably "Isabelle", "SML"; more uniform options ML_read_global, ML_write_global; clarified bootstrap environment;
src/FOL/IFOL.thy
src/Pure/Isar/attrib.ML
src/Pure/ML/ml_compiler.ML
src/Pure/ML/ml_context.ML
src/Pure/ML/ml_env.ML
src/Pure/ML/ml_file.ML
src/Pure/ML_Bootstrap.thy
src/Pure/Pure.thy
src/Pure/Tools/debugger.ML
--- a/src/FOL/IFOL.thy	Mon Aug 27 14:31:52 2018 +0200
+++ b/src/FOL/IFOL.thy	Mon Aug 27 14:42:24 2018 +0200
@@ -8,6 +8,7 @@
 imports Pure
 begin
 
+ML \<open>\<^assert> (not (can ML \<open>open RunCall\<close>))\<close>
 ML_file "~~/src/Tools/misc_legacy.ML"
 ML_file "~~/src/Provers/splitter.ML"
 ML_file "~~/src/Provers/hypsubst.ML"
--- a/src/Pure/Isar/attrib.ML	Mon Aug 27 14:31:52 2018 +0200
+++ b/src/Pure/Isar/attrib.ML	Mon Aug 27 14:42:24 2018 +0200
@@ -587,6 +587,9 @@
   register_config Name_Space.names_short_raw #>
   register_config Name_Space.names_unique_raw #>
   register_config ML_Print_Depth.print_depth_raw #>
+  register_config ML_Env.ML_environment_raw #>
+  register_config ML_Env.ML_read_global_raw #>
+  register_config ML_Env.ML_write_global_raw #>
   register_config ML_Options.source_trace_raw #>
   register_config ML_Options.exception_trace_raw #>
   register_config ML_Options.exception_debugger_raw #>
--- a/src/Pure/ML/ml_compiler.ML	Mon Aug 27 14:31:52 2018 +0200
+++ b/src/Pure/ML/ml_compiler.ML	Mon Aug 27 14:42:24 2018 +0200
@@ -7,7 +7,7 @@
 signature ML_COMPILER =
 sig
   type flags =
-    {SML: bool, exchange: bool, redirect: bool, verbose: bool,
+    {read: string option, write: string option, redirect: bool, verbose: bool,
       debug: bool option, writeln: string -> unit, warning: string -> unit}
   val debug_flags: bool option -> flags
   val flags: flags
@@ -21,17 +21,17 @@
 (* flags *)
 
 type flags =
-  {SML: bool, exchange: bool, redirect: bool, verbose: bool,
+  {read: string option, write: string option, redirect: bool, verbose: bool,
     debug: bool option, writeln: string -> unit, warning: string -> unit};
 
 fun debug_flags opt_debug : flags =
-  {SML = false, exchange = false, redirect = false, verbose = false,
+  {read = NONE, write = NONE, redirect = false, verbose = false,
     debug = opt_debug, writeln = writeln, warning = warning};
 
 val flags = debug_flags NONE;
 
 fun verbose b (flags: flags) =
-  {SML = #SML flags, exchange = #exchange flags, redirect = #redirect flags, verbose = b,
+  {read = #read flags, write = #write flags, redirect = #redirect flags, verbose = b,
     debug = #debug flags, writeln = #writeln flags, warning = #warning flags};
 
 
@@ -154,14 +154,14 @@
     val opt_context = Context.get_generic_context ();
 
     val env as {debug, name_space, add_breakpoints} =
-      (case (ML_Recursive.get (), #SML flags orelse #exchange flags) of
+      (case (ML_Recursive.get (), is_some (#read flags) orelse is_some (#write flags)) of
         (SOME env, false) => env
       | _ =>
        {debug =
           (case #debug flags of
             SOME debug => debug
           | NONE => ML_Options.debugger_enabled opt_context),
-        name_space = ML_Env.make_name_space {SML = #SML flags, exchange = #exchange flags},
+        name_space = ML_Env.make_name_space {read = #read flags, write = #write flags},
         add_breakpoints = ML_Env.add_breakpoints});
 
 
@@ -170,7 +170,7 @@
     val location_props = op ^ (YXML.output_markup (":", #props (Position.dest pos)));
 
     val input_explode =
-      if #SML flags then String.explode
+      if ML_Env.is_standard (ML_Env.default_env (#read flags)) then String.explode
       else maps (String.explode o Symbol.esc) o Symbol.explode;
 
     fun token_content tok =
--- a/src/Pure/ML/ml_context.ML	Mon Aug 27 14:31:52 2018 +0200
+++ b/src/Pure/ML/ml_context.ML	Mon Aug 27 14:42:24 2018 +0200
@@ -195,7 +195,8 @@
   in eval flags pos (ML_Lex.read_pos pos (File.read path)) end;
 
 fun eval_source flags source =
-  eval flags (Input.pos_of source) (ML_Lex.read_source (#SML flags) source);
+  eval flags (Input.pos_of source)
+    (ML_Lex.read_source (ML_Env.is_standard (ML_Env.default_env (#read flags))) source);
 
 fun eval_in ctxt flags pos ants =
   Context.setmp_generic_context (Option.map Context.Proof ctxt)
--- a/src/Pure/ML/ml_env.ML	Mon Aug 27 14:31:52 2018 +0200
+++ b/src/Pure/ML/ml_env.ML	Mon Aug 27 14:42:24 2018 +0200
@@ -7,16 +7,26 @@
 
 signature ML_ENV =
 sig
+  val Isabelle: string
+  val SML: string
+  val is_standard: string -> bool
+  val make_standard: bool -> string
+  val ML_environment_raw: Config.raw
+  val ML_environment: string Config.T
+  val ML_read_global_raw: Config.raw
+  val ML_read_global: bool Config.T
+  val ML_write_global_raw: Config.raw
+  val ML_write_global: bool Config.T
+  val context_env: Context.generic -> string option -> string
+  val default_env: string option -> string
   val inherit: Context.generic -> Context.generic -> Context.generic
-  val forget_structure: string -> Context.generic -> Context.generic
+  val setup: string -> theory -> theory
   val get_breakpoint: Context.generic -> serial -> (bool Unsynchronized.ref * Position.T) option
   val add_breakpoints: (serial * (bool Unsynchronized.ref * Thread_Position.T)) list -> unit
-  val init_bootstrap: Context.generic -> Context.generic
-  val SML_environment: bool Config.T
-  val set_global: bool -> Context.generic -> Context.generic
-  val restore_global: Context.generic -> Context.generic -> Context.generic
-  val add_name_space: {SML: bool} -> ML_Name_Space.T -> Context.generic -> Context.generic
-  val make_name_space: {SML: bool, exchange: bool} -> ML_Name_Space.T
+  val forget_structure: string -> Context.generic -> Context.generic
+  val bootstrap_name_space: Context.generic -> Context.generic
+  val add_name_space: string -> ML_Name_Space.T -> Context.generic -> Context.generic
+  val make_name_space: {read: string option, write: string option} -> ML_Name_Space.T
   val context: ML_Compiler0.context
   val name_space: ML_Name_Space.T
   val check_functor: string -> unit
@@ -25,6 +35,39 @@
 structure ML_Env: ML_ENV =
 struct
 
+(* named environments *)
+
+val Isabelle = "Isabelle";
+val SML = "SML";
+
+fun is_standard env = env <> Isabelle;
+fun make_standard sml = if sml then SML else Isabelle;
+
+val ML_environment_raw = Config.declare ("ML_environment", \<^here>) (fn _ => Config.String Isabelle);
+val ML_environment = Config.string ML_environment_raw;
+
+fun context_env _ (SOME name) = name
+  | context_env context NONE = Config.get_generic context ML_environment;
+
+fun default_env (SOME name) = name
+  | default_env NONE =
+      (case Context.get_generic_context () of
+        NONE => Isabelle
+      | SOME context => context_env context NONE);
+
+
+(* global read/write *)
+
+val ML_read_global_raw = Config.declare ("ML_read_global", \<^here>) (fn _ => Config.Bool true);
+val ML_write_global_raw = Config.declare ("ML_write_global", \<^here>) (fn _ => Config.Bool true);
+
+val ML_read_global = Config.bool ML_read_global_raw;
+val ML_write_global = Config.bool ML_write_global_raw;
+
+fun read_global context = Config.get_generic context ML_read_global;
+fun write_global context = Config.get_generic context ML_write_global;
+
+
 (* name space tables *)
 
 type tables =
@@ -56,141 +99,120 @@
    Symtab.make ML_Name_Space.sml_signature,
    Symtab.make ML_Name_Space.sml_functor);
 
-fun bootstrap_tables ((val1, type1, fixity1, structure1, signature1, functor1): tables) : tables =
-  let
-    val val2 =
-      fold (fn (x, y) =>
-        member (op =) ML_Name_Space.bootstrap_values x ? Symtab.update (x, y))
-      (#allVal ML_Name_Space.global ()) val1;
-    val structure2 =
-      fold (fn (x, y) =>
-        member (op =) ML_Name_Space.bootstrap_structures x ? Symtab.update (x, y))
-      (#allStruct ML_Name_Space.global ()) structure1;
-    val signature2 =
-      fold (fn (x, y) =>
-        member (op =) ML_Name_Space.bootstrap_signatures x ? Symtab.update (x, y))
-      (#allSig ML_Name_Space.global ()) signature1;
-  in (val2, type1, fixity1, structure2, signature2, functor1) end;
-
 
 (* context data *)
 
 type data =
- {global: bool,
-  tables: tables,
-  sml_tables: tables,
+ {envs: tables Name_Space.table,
   breakpoints: (bool Unsynchronized.ref * Position.T) Inttab.table};
 
-fun make_data (global, tables, sml_tables, breakpoints) : data =
-  {global = global, tables = tables, sml_tables = sml_tables, breakpoints = breakpoints};
+fun make_data (envs, breakpoints) : data = {envs = envs, breakpoints = breakpoints};
 
-structure Env = Generic_Data
+structure Data = Generic_Data
 (
   type T = data
-  val empty = make_data (true, empty_tables, sml_tables, Inttab.empty);
-  fun extend (data : T) = make_data (false, #tables data, #sml_tables data, #breakpoints data);
+  val empty = make_data (Name_Space.empty_table "ML_environment", Inttab.empty);
+  fun extend (data : T) = make_data (#envs data, #breakpoints data);
   fun merge (data : T * T) =
-    make_data (false,
-      merge_tables (apply2 #tables data),
-      merge_tables (apply2 #sml_tables data),
+    make_data ((apply2 #envs data) |> Name_Space.join_tables (K merge_tables),
       Inttab.merge (K true) (apply2 #breakpoints data));
 );
 
-val inherit = Env.put o Env.get;
+val inherit = Data.put o Data.get;
 
-fun forget_structure name =
-  Env.map (fn {global, tables, sml_tables, breakpoints} =>
+fun setup env_name thy =
+  thy |> (Context.theory_map o Data.map) (fn {envs, breakpoints} =>
     let
-      val _ = if global then ML_Name_Space.forget_structure name else ();
-      val tables' =
-        (#1 tables, #2 tables, #3 tables, Symtab.delete_safe name (#4 tables), #5 tables, #6 tables);
-    in make_data (global, tables', sml_tables, breakpoints) end);
-
-val get_breakpoint = Inttab.lookup o #breakpoints o Env.get;
+      val thy' = Sign.map_naming (K Name_Space.global_naming) thy;
+      val tables = if env_name = Isabelle then empty_tables else sml_tables;
+      val (_, envs') = envs
+        |> Name_Space.define (Context.Theory thy') true (Binding.name env_name, tables);
+    in make_data (envs', breakpoints) end);
 
-fun add_breakpoints more_breakpoints =
-  if is_some (Context.get_generic_context ()) then
-    Context.>>
-      (Env.map (fn {global, tables, sml_tables, breakpoints} =>
-        let val breakpoints' =
-          fold (Inttab.update_new o (apsnd o apsnd) Position.make) more_breakpoints breakpoints;
-        in make_data (global, tables, sml_tables, breakpoints') end))
-  else ();
-
+val get_env = Name_Space.get o #envs o Data.get;
 
-(* SML environment for Isabelle/ML *)
-
-val SML_environment =
-  Config.bool (Config.declare ("SML_environment", \<^here>) (fn _ => Config.Bool false));
+fun update_env env_name f context = context |> Data.map (fn {envs, breakpoints} =>
+  let
+    val _ = Name_Space.get envs env_name;
+    val envs' = Name_Space.map_table_entry env_name f envs;
+  in make_data (envs', breakpoints) end);
 
-fun sml_env SML =
-  SML orelse
-    (case Context.get_generic_context () of
-      NONE => false
-    | SOME context => Config.get_generic context SML_environment);
+fun forget_structure name context =
+  (if write_global context then ML_Name_Space.forget_structure name else ();
+    context |> update_env Isabelle (fn tables =>
+      (#1 tables, #2 tables, #3 tables, Symtab.delete_safe name (#4 tables), #5 tables, #6 tables)));
 
 
 (* name space *)
 
-val init_bootstrap =
-  Env.map (fn {global, tables, sml_tables, breakpoints} =>
-    make_data (global, tables, bootstrap_tables sml_tables, breakpoints));
+val bootstrap_name_space =
+  update_env Isabelle (fn (tables: tables) =>
+    let
+      fun update entries (x, y) = member (op =) entries x ? Symtab.update (x, y);
+      val bootstrap_val = update ML_Name_Space.bootstrap_values;
+      val bootstrap_structure = update ML_Name_Space.bootstrap_structures;
+      val bootstrap_signature = update ML_Name_Space.bootstrap_signatures;
 
-fun set_global global =
-  Env.map (fn {tables, sml_tables, breakpoints, ...} =>
-    make_data (global, tables, sml_tables, breakpoints));
+      val (val1, type1, fixity1, structure1, signature1, functor1) = sml_tables;
+      val val2 = val1
+        |> fold bootstrap_val (#allVal ML_Name_Space.global ())
+        |> Symtab.fold bootstrap_val (#1 tables);
+      val structure2 = structure1
+        |> fold bootstrap_structure (#allStruct ML_Name_Space.global ())
+        |> Symtab.fold bootstrap_structure (#4 tables);
+      val signature2 = signature1
+        |> fold bootstrap_signature (#allSig ML_Name_Space.global ())
+        |> Symtab.fold bootstrap_signature (#5 tables);
+    in (val2, type1, fixity1, structure2, signature2, functor1) end);
 
-val restore_global = set_global o #global o Env.get;
-
-fun add_name_space {SML} (space: ML_Name_Space.T) =
-  Env.map (fn {global, tables, sml_tables, breakpoints} =>
+fun add_name_space env (space: ML_Name_Space.T) =
+  update_env env (fn (val1, type1, fixity1, structure1, signature1, functor1) =>
     let
-      val (tables', sml_tables') =
-        (tables, sml_tables) |> (if sml_env SML then apsnd else apfst)
-          (fn (val1, type1, fixity1, structure1, signature1, functor1) =>
-            let
-              val val2 = fold Symtab.update (#allVal space ()) val1;
-              val type2 = fold Symtab.update (#allType space ()) type1;
-              val fixity2 = fold Symtab.update (#allFix space ()) fixity1;
-              val structure2 = fold Symtab.update (#allStruct space ()) structure1;
-              val signature2 = fold Symtab.update (#allSig space ()) signature1;
-              val functor2 = fold Symtab.update (#allFunct space ()) functor1;
-            in (val2, type2, fixity2, structure2, signature2, functor2) end);
-    in make_data (global, tables', sml_tables', breakpoints) end);
+      val val2 = fold Symtab.update (#allVal space ()) val1;
+      val type2 = fold Symtab.update (#allType space ()) type1;
+      val fixity2 = fold Symtab.update (#allFix space ()) fixity1;
+      val structure2 = fold Symtab.update (#allStruct space ()) structure1;
+      val signature2 = fold Symtab.update (#allSig space ()) signature1;
+      val functor2 = fold Symtab.update (#allFunct space ()) functor1;
+    in (val2, type2, fixity2, structure2, signature2, functor2) end);
+
+fun make_name_space {read, write} : ML_Name_Space.T =
+  let
+    val read_env = default_env read;
+    val write_env = default_env write;
 
-fun make_name_space {SML, exchange} : ML_Name_Space.T =
-  let
+    fun lookup_env sel1 context name = Symtab.lookup (sel1 (get_env context read_env)) name;
+    fun dest_env sel1 context = Symtab.dest (sel1 (get_env context read_env));
+    fun enter_env ap1 entry = update_env write_env (ap1 (Symtab.update entry));
+
     fun lookup sel1 sel2 name =
-      if sml_env SML then
-        Context.the_generic_context ()
-        |> (fn context => Symtab.lookup (sel1 (#sml_tables (Env.get context))) name)
-      else
-        Context.get_generic_context ()
-        |> (fn NONE => NONE | SOME context => Symtab.lookup (sel1 (#tables (Env.get context))) name)
-        |> (fn NONE => sel2 ML_Name_Space.global name | some => some);
+      if read_env = Isabelle then
+        (case Context.get_generic_context () of
+          NONE => sel2 ML_Name_Space.global name
+        | SOME context =>
+            (case lookup_env sel1 context name of
+              NONE => if read_global context then sel2 ML_Name_Space.global name else NONE
+            | some => some))
+      else lookup_env sel1 (Context.the_generic_context ()) name;
 
     fun all sel1 sel2 () =
-      (if sml_env SML then
-        Context.the_generic_context ()
-        |> (fn context => Symtab.dest (sel1 (#sml_tables (Env.get context))))
-      else
-        Context.get_generic_context ()
-        |> (fn NONE => [] | SOME context => Symtab.dest (sel1 (#tables (Env.get context))))
-        |> append (sel2 ML_Name_Space.global ()))
-      |> sort_distinct (string_ord o apply2 #1);
+      sort_distinct (string_ord o apply2 #1)
+        (if read_env = Isabelle then
+          (case Context.get_generic_context () of
+            NONE => sel2 ML_Name_Space.global ()
+          | SOME context =>
+              dest_env sel1 context @
+              (if read_global context then sel2 ML_Name_Space.global () else []))
+         else dest_env sel1 (Context.the_generic_context ()));
 
     fun enter ap1 sel2 entry =
-      if sml_env SML <> exchange then
-        Context.>> (Env.map (fn {global, tables, sml_tables, breakpoints} =>
-          let val sml_tables' = ap1 (Symtab.update entry) sml_tables
-          in make_data (global, tables, sml_tables', breakpoints) end))
-      else if is_some (Context.get_generic_context ()) then
-        Context.>> (Env.map (fn {global, tables, sml_tables, breakpoints} =>
-          let
-            val _ = if global then sel2 ML_Name_Space.global entry else ();
-            val tables' = ap1 (Symtab.update entry) tables;
-          in make_data (global, tables', sml_tables, breakpoints) end))
-      else sel2 ML_Name_Space.global entry;
+      if write_env = Isabelle then
+        (case Context.get_generic_context () of
+          NONE => sel2 ML_Name_Space.global entry
+        | SOME context =>
+            (if write_global context then sel2 ML_Name_Space.global entry else ();
+             Context.>> (enter_env ap1 entry)))
+      else Context.>> (enter_env ap1 entry);
   in
    {lookupVal    = lookup #1 #lookupVal,
     lookupType   = lookup #2 #lookupType,
@@ -213,7 +235,7 @@
   end;
 
 val context: ML_Compiler0.context =
- {name_space = make_name_space {SML = false, exchange = false},
+ {name_space = make_name_space {read = NONE, write = NONE},
   print_depth = NONE,
   here = Position.here oo Position.line_file,
   print = writeln,
@@ -227,4 +249,20 @@
   if not (is_functor "Table") (*mask dummy version of name_space*) orelse is_functor name then ()
   else error ("Unknown ML functor: " ^ quote name);
 
+
+(* breakpoints *)
+
+val get_breakpoint = Inttab.lookup o #breakpoints o Data.get;
+
+fun add_breakpoints more_breakpoints =
+  if is_some (Context.get_generic_context ()) then
+    Context.>>
+      (Data.map (fn {envs, breakpoints} =>
+        let val breakpoints' =
+          fold (Inttab.update_new o (apsnd o apsnd) Position.make) more_breakpoints breakpoints;
+        in make_data (envs, breakpoints') end))
+  else ();
+
 end;
+
+Theory.setup (ML_Env.setup ML_Env.Isabelle #> ML_Env.setup ML_Env.SML);
--- a/src/Pure/ML/ml_file.ML	Mon Aug 27 14:31:52 2018 +0200
+++ b/src/Pure/ML/ml_file.ML	Mon Aug 27 14:42:24 2018 +0200
@@ -6,6 +6,8 @@
 
 signature ML_FILE =
 sig
+  val command: string option -> bool option -> (theory -> Token.file list) ->
+    Toplevel.transition -> Toplevel.transition
   val ML: bool option -> (theory -> Token.file list) -> Toplevel.transition -> Toplevel.transition
   val SML: bool option -> (theory -> Token.file list) -> Toplevel.transition -> Toplevel.transition
 end;
@@ -13,7 +15,7 @@
 structure ML_File: ML_FILE =
 struct
 
-fun command SML debug files = Toplevel.generic_theory (fn gthy =>
+fun command env debug files = Toplevel.generic_theory (fn gthy =>
   let
     val [{src_path, lines, digest, pos}: Token.file] = files (Context.theory_of gthy);
     val provide = Resources.provide (src_path, digest);
@@ -21,8 +23,8 @@
 
     val _ = Thy_Output.check_comments (Context.proof_of gthy) (Input.source_explode source);
 
-    val flags =
-      {SML = SML, exchange = false, redirect = true, verbose = true,
+    val flags: ML_Compiler.flags =
+      {read = env, write = env, redirect = true, verbose = true,
         debug = debug, writeln = writeln, warning = warning};
   in
     gthy
@@ -31,7 +33,7 @@
     |> Context.mapping provide (Local_Theory.background_theory provide)
   end);
 
-val ML = command false;
-val SML = command true;
+val ML = command NONE;
+val SML = command (SOME ML_Env.SML);
 
 end;
--- a/src/Pure/ML_Bootstrap.thy	Mon Aug 27 14:31:52 2018 +0200
+++ b/src/Pure/ML_Bootstrap.thy	Mon Aug 27 14:42:24 2018 +0200
@@ -11,35 +11,37 @@
 external_file "$POLYML_EXE"
 
 
-subsection \<open>Standard ML environment for virtual bootstrap\<close>
+subsection \<open>ML environment for virtual bootstrap\<close>
 
-setup \<open>Context.theory_map ML_Env.init_bootstrap\<close>
-
-SML_import \<open>
+ML \<open>
+  #allStruct ML_Name_Space.global () |> List.app (fn (name, _) =>
+    if member (op =) ML_Name_Space.hidden_structures name then
+      ML (Input.string ("structure " ^ name ^ " = " ^ name))
+    else ());
   structure Output_Primitives = Output_Primitives_Virtual;
   structure Thread_Data = Thread_Data_Virtual;
+  structure PolyML = PolyML;
   fun ML_system_pp (_: FixedInt.int -> 'a -> 'b -> PolyML_Pretty.pretty) = ();
 \<close>
 
 
-subsection \<open>Final setup of global ML environment\<close>
+subsection \<open>Global ML environment for Isabelle/Pure\<close>
 
 ML \<open>Proofterm.proofs := 0\<close>
 
-ML_export \<open>
-  List.app ML_Name_Space.forget_structure ML_Name_Space.hidden_structures;
-  structure PolyML =
-  struct
-    val pointerEq = pointer_eq;
-    structure IntInf = PolyML.IntInf;
-  end;
+ML \<open>
+  Context.setmp_generic_context NONE
+    ML \<open>
+      List.app ML_Name_Space.forget_structure ML_Name_Space.hidden_structures;
+      structure PolyML =
+      struct
+        val pointerEq = pointer_eq;
+        structure IntInf = PolyML.IntInf;
+      end;
+    \<close>
 \<close>
 
-ML \<open>\<^assert> (not (can ML \<open>open RunCall\<close>))\<close>
-
-
-subsection \<open>Switch to bootstrap environment\<close>
-
-setup \<open>Config.put_global ML_Env.SML_environment true\<close>
+setup \<open>Context.theory_map ML_Env.bootstrap_name_space\<close>
+declare [[ML_read_global = false]]
 
 end
--- a/src/Pure/Pure.thy	Mon Aug 27 14:31:52 2018 +0200
+++ b/src/Pure/Pure.thy	Mon Aug 27 14:42:24 2018 +0200
@@ -170,7 +170,7 @@
     (Parse.ML_source >> (fn source =>
       let
         val flags: ML_Compiler.flags =
-          {SML = true, exchange = true, redirect = false, verbose = true,
+          {read = SOME ML_Env.SML, write = NONE, redirect = false, verbose = true,
             debug = NONE, writeln = writeln, warning = warning};
       in
         Toplevel.theory
@@ -182,7 +182,7 @@
     (Parse.ML_source >> (fn source =>
       let
         val flags: ML_Compiler.flags =
-          {SML = false, exchange = true, redirect = false, verbose = true,
+          {read = NONE, write = SOME ML_Env.SML, redirect = false, verbose = true,
             debug = NONE, writeln = writeln, warning = warning};
       in
         Toplevel.generic_theory
@@ -196,10 +196,11 @@
     (Parse.ML_source >> (fn source =>
       Toplevel.generic_theory (fn context =>
         context
-        |> ML_Env.set_global true
+        |> Config.put_generic ML_Env.ML_write_global true
         |> ML_Context.exec (fn () =>
             ML_Context.eval_source (ML_Compiler.verbose true ML_Compiler.flags) source)
-        |> ML_Env.restore_global context
+        |> Config.put_generic ML_Env.ML_write_global
+            (Config.get_generic context ML_Env.ML_write_global)
         |> Local_Theory.propagate_ml_env)));
 
 val _ =
@@ -1440,4 +1441,6 @@
   qed
 qed
 
+declare [[ML_write_global = false]]
+
 end
--- a/src/Pure/Tools/debugger.ML	Mon Aug 27 14:31:52 2018 +0200
+++ b/src/Pure/Tools/debugger.ML	Mon Aug 27 14:42:24 2018 +0200
@@ -132,15 +132,17 @@
     "Context.put_generic_context (SOME ML_context)"];
 
 fun evaluate {SML, verbose} =
-  ML_Context.eval
-    {SML = SML, exchange = false, redirect = false, verbose = verbose,
-      debug = SOME false, writeln = writeln_message, warning = warning_message}
-    Position.none;
+  let val env = ML_Env.make_standard SML in
+    ML_Context.eval
+      {read = SOME env, write = SOME env, redirect = false, verbose = verbose,
+        debug = SOME false, writeln = writeln_message, warning = warning_message}
+      Position.none
+  end;
 
 fun eval_setup thread_name index SML context =
   context
   |> Context_Position.set_visible_generic false
-  |> ML_Env.add_name_space {SML = SML}
+  |> ML_Env.add_name_space (ML_Env.make_standard SML)
       (PolyML.DebuggerInterface.debugNameSpace (the_debug_state thread_name index));
 
 fun eval_context thread_name index SML toks =