# HG changeset patch
# User wenzelm
# Date 1562232360 -7200
# Node ID 03430649a7d287b4f3a4872035d51897acbcadbe
# Parent  470d4f145e4cb636e9379e51e0d5f1487e0b1f24
clarified history stage: allow independent updates that are merged later;

diff -r 470d4f145e4c -r 03430649a7d2 src/Pure/context.ML
--- a/src/Pure/context.ML	Mon Jun 24 16:26:25 2019 +0200
+++ b/src/Pure/context.ML	Thu Jul 04 11:26:00 2019 +0200
@@ -117,6 +117,10 @@
 
 (** datatype theory **)
 
+type stage = int * int Synchronized.var;
+fun init_stage () : stage = (0, Synchronized.var "Context.stage" 1);
+fun next_stage ((_, state): stage) = (Synchronized.change_result state (fn n => (n, n + 1)), state);
+
 datatype theory_id =
   Theory_Id of
    (*identity*)
@@ -124,7 +128,7 @@
     ids: Inttab.set} *            (*cumulative identifiers -- symbolic body content*)
    (*history*)
    {name: string,                 (*official theory name*)
-    stage: int};                  (*counter for anonymous updates*)
+    stage: stage option};         (*index and counter for anonymous updates*)
 
 datatype theory =
   Theory of
@@ -153,7 +157,7 @@
 val data_of = #3 o rep_theory;
 
 fun make_identity id ids = {id = id, ids = ids};
-fun make_history name stage = {name = name, stage = stage};
+fun make_history name = {name = name, stage = SOME (init_stage ())};
 fun make_ancestry parents ancestors = {parents = parents, ancestors = ancestors};
 
 val theory_id_long_name = #name o history_of_id;
@@ -169,11 +173,11 @@
 (* names *)
 
 val PureN = "Pure";
-val finished = ~1;
 
 fun display_name thy_id =
-  let val {name, stage} = history_of_id thy_id;
-  in if stage = finished then name else name ^ ":" ^ string_of_int stage end;
+  (case history_of_id thy_id of
+    {name, stage = NONE} => name
+  | {name, stage = SOME (i, _)} => name ^ ":" ^ string_of_int i);
 
 fun display_names thy =
   let
@@ -197,7 +201,7 @@
     (case find_first (fn thy' => theory_name' long thy' = name) (ancestors_of thy) of
       SOME thy' => thy'
     | NONE => error ("Unknown ancestor theory " ^ quote name))
-  else if #stage (history_of thy) = finished then thy
+  else if is_none (#stage (history_of thy)) then thy
   else error ("Unfinished theory " ^ quote name);
 
 
@@ -335,7 +339,7 @@
 (* primitives *)
 
 val pre_pure_thy =
-  create_thy Inttab.empty (make_history PureN 0) (make_ancestry [] []) Datatab.empty;
+  create_thy Inttab.empty (make_history PureN) (make_ancestry [] []) Datatab.empty;
 
 local
 
@@ -344,10 +348,10 @@
     val Theory_Id ({id, ids}, {name, stage}) = theory_id thy;
     val Theory (_, ancestry, data) = thy;
     val (ancestry', data') =
-      if stage = finished then
+      if is_none stage then
         (make_ancestry [thy] (extend_ancestors thy (ancestors_of thy)), extend_data data)
       else (ancestry, data);
-    val history' = {name = name, stage = if finish then finished else stage + 1};
+    val history' = {name = name, stage = if finish then NONE else Option.map next_stage stage};
     val ids' = insert_id id ids;
     val data'' = f data';
   in create_thy ids' history' ancestry' data'' end;
@@ -368,7 +372,7 @@
 fun merge_thys thys =
   let
     val ids = merge_ids thys;
-    val history = make_history "" 0;
+    val history = make_history "";
     val ancestry = make_ancestry [] [];
     val data = merge_data thys (apply2 data_of thys);
   in create_thy ids history ancestry data end;
@@ -394,7 +398,7 @@
         | thy :: thys => Library.foldl merge_thys (thy, thys));
       val Theory_Id ({ids, ...}, _) = theory_id thy0;
 
-      val history = make_history name 0;
+      val history = make_history name;
       val ancestry = make_ancestry parents ancestors;
     in create_thy ids history ancestry (data_of thy0) |> tap finish_thy end;