back to uniform serial (reverting 913b4afb6ac2): this allows to treat derivation id like name space entity id;
authorwenzelm
Mon, 19 Aug 2019 20:00:29 +0200
changeset 70577 ed651a58afe4
parent 70576 3554531505a8
child 70578 7bb2bbb3ccd6
back to uniform serial (reverting 913b4afb6ac2): this allows to treat derivation id like name space entity id;
src/Pure/Proof/extraction.ML
src/Pure/global_theory.ML
src/Pure/proofterm.ML
--- a/src/Pure/Proof/extraction.ML	Mon Aug 19 19:31:31 2019 +0200
+++ b/src/Pure/Proof/extraction.ML	Mon Aug 19 20:00:29 2019 +0200
@@ -622,7 +622,7 @@
                     val corr_prf = mkabsp shyps corr_prf0;
                     val corr_prop = Proofterm.prop_of corr_prf;
                     val corr_header =
-                      Proofterm.thm_header (Proofterm.proof_serial ()) pos theory_name
+                      Proofterm.thm_header (serial ()) pos theory_name
                         (corr_name name vs') corr_prop
                         (SOME (map TVar (Term.add_tvars corr_prop [] |> rev)));
                     val corr_body = Proofterm.thm_body (Proofterm.approximate_proof_body corr_prf);
@@ -743,7 +743,7 @@
                              SOME (map TVar (Term.add_tvars eqn [] |> rev))))) %% corr_prf);
                     val corr_prop = Proofterm.prop_of corr_prf';
                     val corr_header =
-                      Proofterm.thm_header (Proofterm.proof_serial ()) pos theory_name
+                      Proofterm.thm_header (serial ()) pos theory_name
                         (corr_name s vs') corr_prop
                         (SOME (map TVar (Term.add_tvars corr_prop [] |> rev)));
                     val corr_body = Proofterm.thm_body (Proofterm.approximate_proof_body corr_prf');
--- a/src/Pure/global_theory.ML	Mon Aug 19 19:31:31 2019 +0200
+++ b/src/Pure/global_theory.ML	Mon Aug 19 20:00:29 2019 +0200
@@ -13,7 +13,7 @@
   val alias_fact: binding -> string -> theory -> theory
   val hide_fact: bool -> string -> theory -> theory
   val dest_thms: bool -> theory list -> theory -> (Thm_Name.T * thm) list
-  val dest_thm_names: theory -> (proof_serial * Thm_Name.T) list
+  val dest_thm_names: theory -> (serial * Thm_Name.T) list
   val lookup_thm_id: theory -> Proofterm.thm_id -> Thm_Name.T option
   val lookup_thm: theory -> thm -> Thm_Name.T option
   val get_thms: theory -> xstring -> thm list
--- a/src/Pure/proofterm.ML	Mon Aug 19 19:31:31 2019 +0200
+++ b/src/Pure/proofterm.ML	Mon Aug 19 20:00:29 2019 +0200
@@ -9,9 +9,8 @@
 signature BASIC_PROOFTERM =
 sig
   type thm_node
-  type proof_serial = int
   type thm_header =
-    {serial: proof_serial, pos: Position.T list, theory_name: string, name: string,
+    {serial: serial, pos: Position.T list, theory_name: string, name: string,
       prop: term, types: typ list option}
   type thm_body
   datatype proof =
@@ -28,7 +27,7 @@
    | PThm of thm_header * thm_body
   and proof_body = PBody of
     {oracles: (string * term option) Ord_List.T,
-     thms: (proof_serial * thm_node) Ord_List.T,
+     thms: (serial * thm_node) Ord_List.T,
      proof: proof}
   val %> : proof * term -> proof
 end;
@@ -38,11 +37,11 @@
   include BASIC_PROOFTERM
   val proofs: int Unsynchronized.ref
   exception MIN_PROOF
-  type pthm = proof_serial * thm_node
+  type pthm = serial * thm_node
   type oracle = string * term option
   val proof_of: proof_body -> proof
   val map_proof_of: (proof -> proof) -> proof_body -> proof_body
-  val thm_header: proof_serial -> Position.T list -> string -> string -> term -> typ list option ->
+  val thm_header: serial -> Position.T list -> string -> string -> term -> typ list option ->
     thm_header
   val thm_body: proof_body -> thm_body
   val thm_body_proof_raw: thm_body -> proof
@@ -53,7 +52,7 @@
   val join_proof: proof_body future -> proof
   val fold_proof_atoms: bool -> (proof -> 'a -> 'a) -> proof list -> 'a -> 'a
   val fold_body_thms:
-    ({serial: proof_serial, name: string, prop: term, body: proof_body} -> 'a -> 'a) ->
+    ({serial: serial, name: string, prop: term, body: proof_body} -> 'a -> 'a) ->
     proof_body list -> 'a -> 'a
   val consolidate: proof_body list -> unit
 
@@ -168,7 +167,6 @@
   val standard_vars: Name.context -> term * proof option -> term * proof option
   val standard_vars_term: Name.context -> term -> term
 
-  val proof_serial: unit -> proof_serial
   val fulfill_norm_proof: theory -> (serial * proof_body) list -> proof_body -> proof_body
   val thm_proof: theory -> (class * class -> proof) ->
     (string * class list list * class -> proof) -> string * Position.T -> sort list ->
@@ -177,7 +175,7 @@
     (string * class list list * class -> proof) -> sort list -> term ->
     (serial * proof_body future) list -> proof_body -> pthm * proof
   val get_approximative_name: sort list -> term list -> term -> proof -> string
-  type thm_id = {serial: proof_serial, theory_name: string}
+  type thm_id = {serial: serial, theory_name: string}
   val get_id: sort list -> term list -> term -> proof -> thm_id option
 end
 
@@ -186,10 +184,8 @@
 
 (** datatype proof **)
 
-type proof_serial = int;
-
 type thm_header =
-  {serial: proof_serial, pos: Position.T list, theory_name: string, name: string,
+  {serial: serial, pos: Position.T list, theory_name: string, name: string,
     prop: term, types: typ list option};
 
 datatype proof =
@@ -206,7 +202,7 @@
  | PThm of thm_header * thm_body
 and proof_body = PBody of
   {oracles: (string * term option) Ord_List.T,
-   thms: (proof_serial * thm_node) Ord_List.T,
+   thms: (serial * thm_node) Ord_List.T,
    proof: proof}
 and thm_body =
   Thm_Body of {export_proof: unit lazy, open_proof: proof -> proof, body: proof_body future}
@@ -218,7 +214,7 @@
 type oracle = string * term option;
 val oracle_prop = the_default Term.dummy;
 
-type pthm = proof_serial * thm_node;
+type pthm = serial * thm_node;
 
 fun proof_of (PBody {proof, ...}) = proof;
 val join_proof = Future.join #> proof_of;
@@ -2067,8 +2063,6 @@
 
 (* PThm nodes *)
 
-val proof_serial = Counter.make ();
-
 local
 
 fun unconstrainT_proof algebra classrel_proof arity_proof (ucontext: Logic.unconstrain_context) =
@@ -2156,7 +2150,7 @@
 
     fun new_prf () =
       let
-        val i = proof_serial ();
+        val i = serial ();
         val unconstrainT =
           unconstrainT_proof (Sign.classes_of thy) classrel_proof arity_proof ucontext;
         val postproc = map_proof_of unconstrainT #> named ? publish i;
@@ -2165,12 +2159,12 @@
     val (i, body') =
       (*non-deterministic, depends on unknown promises*)
       (case strip_combt (fst (strip_combP prf)) of
-        (PThm ({serial, name = a, prop = prop', types = NONE, ...}, thm_body'), args') =>
+        (PThm ({serial = ser, name = a, prop = prop', types = NONE, ...}, thm_body'), args') =>
           if (a = "" orelse a = name) andalso prop' = prop1 andalso args' = args then
             let
               val Thm_Body {body = body', ...} = thm_body';
-              val i = if a = "" andalso named then proof_serial () else serial;
-            in (i, body' |> serial <> i ? Future.map (publish i)) end
+              val i = if a = "" andalso named then serial () else ser;
+            in (i, body' |> ser <> i ? Future.map (publish i)) end
           else new_prf ()
       | _ => new_prf ());
 
@@ -2218,7 +2212,7 @@
   Option.map #name (get_identity shyps hyps prop prf) |> the_default "";
 
 
-type thm_id = {serial: proof_serial, theory_name: string};
+type thm_id = {serial: serial, theory_name: string};
 
 fun get_id shyps hyps prop prf : thm_id option =
   (case get_identity shyps hyps prop prf of