# HG changeset patch
# User wenzelm
# Date 1535747158 -7200
# Node ID dd44e31ca2c639b0915695c88020c14f044a73d8
# Parent  1dacce27bc25be3a1ca3954ff4235d9fb7270c79
support multiple inheritance of ML environments, with canonical merge order as in Context.begin_theory;

diff -r 1dacce27bc25 -r dd44e31ca2c6 src/Pure/Isar/local_theory.ML
--- a/src/Pure/Isar/local_theory.ML	Fri Aug 31 16:17:30 2018 +0200
+++ b/src/Pure/Isar/local_theory.ML	Fri Aug 31 22:25:58 2018 +0200
@@ -251,7 +251,7 @@
 fun target_morphism lthy = standard_morphism lthy (target_of lthy);
 
 fun propagate_ml_env (context as Context.Proof lthy) =
-      let val inherit = ML_Env.inherit context in
+      let val inherit = ML_Env.inherit [context] in
         lthy
         |> background_theory (Context.theory_map inherit)
         |> map_contexts (K (Context.proof_map inherit))
diff -r 1dacce27bc25 -r dd44e31ca2c6 src/Pure/Isar/proof.ML
--- a/src/Pure/Isar/proof.ML	Fri Aug 31 16:17:30 2018 +0200
+++ b/src/Pure/Isar/proof.ML	Fri Aug 31 22:25:58 2018 +0200
@@ -237,7 +237,7 @@
 fun map_contexts f = map_all (fn (ctxt, facts, mode, goal) => (f ctxt, facts, mode, goal));
 
 fun propagate_ml_env state = map_contexts
-  (Context.proof_map (ML_Env.inherit (Context.Proof (context_of state)))) state;
+  (Context.proof_map (ML_Env.inherit [Context.Proof (context_of state)])) state;
 
 
 (* facts *)
diff -r 1dacce27bc25 -r dd44e31ca2c6 src/Pure/ML/ml_context.ML
--- a/src/Pure/ML/ml_context.ML	Fri Aug 31 16:17:30 2018 +0200
+++ b/src/Pure/ML/ml_context.ML	Fri Aug 31 22:25:58 2018 +0200
@@ -168,7 +168,7 @@
         (Option.map (Context.Proof o Context_Position.set_visible false) env_ctxt)
         (fn () =>
           (ML_Compiler.eval non_verbose Position.none env; Context.get_generic_context ())) ()
-      |> (fn NONE => () | SOME context' => Context.>> (ML_Env.inherit context'));
+      |> (fn NONE => () | SOME context' => Context.>> (ML_Env.inherit [context']));
 
     (*eval body*)
     val _ = ML_Compiler.eval flags pos body;
diff -r 1dacce27bc25 -r dd44e31ca2c6 src/Pure/ML/ml_env.ML
--- a/src/Pure/ML/ml_env.ML	Fri Aug 31 16:17:30 2018 +0200
+++ b/src/Pure/ML/ml_env.ML	Fri Aug 31 22:25:58 2018 +0200
@@ -15,7 +15,7 @@
   val ML_read_global: bool Config.T
   val ML_write_global_raw: Config.raw
   val ML_write_global: bool Config.T
-  val inherit: Context.generic -> Context.generic -> Context.generic
+  val inherit: Context.generic list -> Context.generic -> Context.generic
   type operations =
    {read_source: Input.source -> ML_Lex.token Antiquote.antiquote list,
     explode_token: ML_Lex.token -> char list}
@@ -101,20 +101,31 @@
  {read_source: Input.source -> ML_Lex.token Antiquote.antiquote list,
   explode_token: ML_Lex.token -> char list};
 
+local
+
 type env = tables * operations;
+type data = env Name_Space.table * (bool Unsynchronized.ref * Position.T) Inttab.table;
+
+val empty_data: data = (Name_Space.empty_table "ML_environment", Inttab.empty);
+
+fun merge_data ((envs1, breakpoints1), (envs2, breakpoints2)) : data =
+  ((envs1, envs2) |> Name_Space.join_tables
+    (K (fn ((tables1, ops), (tables2, _)) => (merge_tables (tables1, tables2), ops))),
+   Inttab.merge (K true) (breakpoints1, breakpoints2));
+
+in
 
 structure Data = Generic_Data
 (
-  type T = env Name_Space.table * (bool Unsynchronized.ref * Position.T) Inttab.table;
-  val empty: T = (Name_Space.empty_table "ML_environment", Inttab.empty);
+  type T = data;
+  val empty = empty_data;
   val extend = I;
-  fun merge ((envs1, breakpoints1), (envs2, breakpoints2)) : T =
-    ((envs1, envs2) |> Name_Space.join_tables
-      (K (fn ((tables1, ops), (tables2, _)) => (merge_tables (tables1, tables2), ops))),
-     Inttab.merge (K true) (breakpoints1, breakpoints2));
+  val merge = merge_data;
 );
 
-val inherit = Data.put o Data.get;
+fun inherit contexts = Data.put (Library.foldl1 merge_data (map Data.get contexts));
+
+end;
 
 val get_env = Name_Space.get o #1 o Data.get;
 val get_tables = #1 oo get_env;