tuned;
authorwenzelm
Mon, 27 Aug 2018 15:18:18 +0200
changeset 68818 6debac400787
parent 68817 b9568a82b474
child 68819 9cfa4aa35719
tuned;
src/Pure/ML/ml_env.ML
--- a/src/Pure/ML/ml_env.ML	Mon Aug 27 15:01:52 2018 +0200
+++ b/src/Pure/ML/ml_env.ML	Mon Aug 27 15:18:18 2018 +0200
@@ -21,8 +21,6 @@
   val setup: string -> theory -> theory
   val context_env: Context.generic -> string option -> string
   val default_env: string option -> string
-  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 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
@@ -30,6 +28,8 @@
   val context: ML_Compiler0.context
   val name_space: ML_Name_Space.T
   val check_functor: string -> unit
+  val get_breakpoint: Context.generic -> serial -> (bool Unsynchronized.ref * Position.T) option
+  val add_breakpoints: (serial * (bool Unsynchronized.ref * Thread_Position.T)) list -> unit
 end
 
 structure ML_Env: ML_ENV =
@@ -93,40 +93,30 @@
 
 (* context data *)
 
-type data =
- {envs: tables Name_Space.table,
-  breakpoints: (bool Unsynchronized.ref * Position.T) Inttab.table};
-
-fun make_data (envs, breakpoints) : data = {envs = envs, breakpoints = breakpoints};
-
 structure Data = Generic_Data
 (
-  type T = 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 ((apply2 #envs data) |> Name_Space.join_tables (K merge_tables),
-      Inttab.merge (K true) (apply2 #breakpoints data));
+  type T = tables Name_Space.table * (bool Unsynchronized.ref * Position.T) Inttab.table;
+  val empty: T = (Name_Space.empty_table "ML_environment", Inttab.empty);
+  val extend = I;
+  fun merge ((envs1, breakpoints1), (envs2, breakpoints2)) : T =
+    (Name_Space.join_tables (K merge_tables) (envs1, envs2),
+      Inttab.merge (K true) (breakpoints1, breakpoints2));
 );
 
 val inherit = Data.put o Data.get;
 
 fun setup env_name thy =
-  thy |> (Context.theory_map o Data.map) (fn {envs, breakpoints} =>
+  thy |> (Context.theory_map o Data.map o apfst) (fn envs =>
     let
       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);
+    in #2 (Name_Space.define (Context.Theory thy') true (Binding.name env_name, tables) envs) end);
 
-val get_env = Name_Space.get o #envs o Data.get;
+val get_env = Name_Space.get o #1 o Data.get;
 
-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 update_env env_name f context = context |> Data.map (apfst (fn envs =>
+  let val _ = Name_Space.get envs env_name;
+  in Name_Space.map_table_entry env_name f envs end));
 
 fun forget_structure name context =
   (if write_global context then ML_Name_Space.forget_structure name else ();
@@ -264,15 +254,13 @@
 
 (* breakpoints *)
 
-val get_breakpoint = Inttab.lookup o #breakpoints o Data.get;
+val get_breakpoint = Inttab.lookup o #2 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))
+      ((Data.map o apsnd)
+        (fold (Inttab.update_new o (apsnd o apsnd) Position.make) more_breakpoints))
   else ();
 
 end;