# HG changeset patch # User wenzelm # Date 1535375898 -7200 # Node ID 6debac400787aa1b01b7e5a125d665e726e3a39f # Parent b9568a82b474af36361af4a2c325f8b3370553ba tuned; diff -r b9568a82b474 -r 6debac400787 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;