tuned signature;
authorwenzelm
Mon, 02 Dec 2024 20:35:12 +0100
changeset 81540 58073f3d748a
parent 81539 8e4ca2c87e86
child 81541 5335b1ca6233
tuned signature;
src/Pure/General/table.ML
src/Pure/Syntax/syntax_phases.ML
src/Pure/term_items.ML
src/Pure/thm.ML
src/Pure/zterm.ML
--- a/src/Pure/General/table.ML	Mon Dec 02 18:53:45 2024 +0100
+++ b/src/Pure/General/table.ML	Mon Dec 02 20:35:12 2024 +0100
@@ -68,6 +68,7 @@
   val make_set: key list -> set
   type 'a cache_ops = {apply: key -> 'a, reset: unit -> unit, size: unit -> int}
   val unsynchronized_cache: (key -> 'a) -> 'a cache_ops
+  val apply_unsynchronized_cache: (key -> 'a) -> key -> 'a
 end;
 
 functor Table(Key: KEY): TABLE =
@@ -610,6 +611,8 @@
     fun total_size () = size (! cache1) + size (! cache2);
   in {apply = apply, reset = reset, size = total_size} end;
 
+fun apply_unsynchronized_cache f = #apply (unsynchronized_cache f);
+
 
 (* ML pretty-printing *)
 
--- a/src/Pure/Syntax/syntax_phases.ML	Mon Dec 02 18:53:45 2024 +0100
+++ b/src/Pure/Syntax/syntax_phases.ML	Mon Dec 02 20:35:12 2024 +0100
@@ -65,15 +65,14 @@
   Markup.bound :: map (fn pos => Position.make_entity_markup def id Markup.boundN (name, pos)) ps;
 
 fun markup_entity_cache ctxt =
-  Symtab.unsynchronized_cache (fn c =>
+  Symtab.apply_unsynchronized_cache (fn c =>
     Syntax.get_consts (Proof_Context.syntax_of ctxt) c
     |> maps (Lexicon.unmark
        {case_class = markup_class ctxt,
         case_type = markup_type ctxt,
         case_const = markup_const ctxt,
         case_fixed = markup_free ctxt,
-        case_default = K []}))
-  |> #apply;
+        case_default = K []}));
 
 
 
@@ -267,8 +266,8 @@
 
 fun decode_term ctxt =
   let
-    val markup_free_cache = #apply (Symtab.unsynchronized_cache (markup_free ctxt));
-    val markup_const_cache = #apply (Symtab.unsynchronized_cache (markup_const ctxt));
+    val markup_free_cache = Symtab.apply_unsynchronized_cache (markup_free ctxt);
+    val markup_const_cache = Symtab.apply_unsynchronized_cache (markup_const ctxt);
 
     fun decode (result as (_: Position.report_text list, Exn.Exn _)) = result
       | decode (reports0, Exn.Res tm) =
@@ -714,7 +713,7 @@
 local
 
 fun extern_cache ctxt =
-  Symtab.unsynchronized_cache (fn c =>
+  Symtab.apply_unsynchronized_cache (fn c =>
     (case Syntax.get_consts (Proof_Context.syntax_of ctxt) c of
       [b] => b
     | bs =>
@@ -722,18 +721,16 @@
           [] => c
         | [b] => b
         | _ => error ("Multiple logical entities for " ^ quote c ^ ": " ^ commas_quote bs)))
-    |> Proof_Context.extern_entity ctxt)
-  |> #apply;
+    |> Proof_Context.extern_entity ctxt);
 
 val var_or_skolem_cache =
-  Symtab.unsynchronized_cache (fn s =>
+  Symtab.apply_unsynchronized_cache (fn s =>
     (case Lexicon.read_variable s of
       SOME (x, i) =>
         (case try Name.dest_skolem x of
           SOME x' => (Markup.skolem, Term.string_of_vname (x', i))
         | NONE => (Markup.var, s))
-    | NONE => (Markup.var, s)))
-  |> #apply;
+    | NONE => (Markup.var, s)));
 
 val typing_elem = YXML.output_markup_elem Markup.typing;
 val sorting_elem = YXML.output_markup_elem Markup.sorting;
@@ -751,8 +748,8 @@
     val extern = extern_cache ctxt;
 
     val free_or_skolem_cache =
-      Symtab.unsynchronized_cache (fn x => (markup_free ctxt x, Proof_Context.extern_fixed ctxt x))
-      |> #apply;
+      Symtab.apply_unsynchronized_cache (fn x =>
+        (markup_free ctxt x, Proof_Context.extern_fixed ctxt x));
 
     val cache1 = Unsynchronized.ref (Ast.Table.empty: Markup.output Pretty.block Ast.Table.table);
     val cache2 = Unsynchronized.ref (Ast.Table.empty: Markup.output Pretty.block Ast.Table.table);
--- a/src/Pure/term_items.ML	Mon Dec 02 18:53:45 2024 +0100
+++ b/src/Pure/term_items.ML	Mon Dec 02 20:35:12 2024 +0100
@@ -36,6 +36,7 @@
   val make3: key * 'a -> key * 'a -> key * 'a -> 'a table
   type 'a cache_ops = {apply: key -> 'a, reset: unit -> unit, size: unit -> int};
   val unsynchronized_cache: (key -> 'a) -> 'a cache_ops
+  val apply_unsynchronized_cache: (key -> 'a) -> key -> 'a
   type set = int table
   val add_set: key -> set -> set
   val make_set: key list -> set
@@ -89,6 +90,7 @@
 
 type 'a cache_ops = 'a Table.cache_ops;
 val unsynchronized_cache = Table.unsynchronized_cache;
+val apply_unsynchronized_cache = Table.apply_unsynchronized_cache;
 
 
 (* set with order of addition *)
--- a/src/Pure/thm.ML	Mon Dec 02 18:53:45 2024 +0100
+++ b/src/Pure/thm.ML	Mon Dec 02 20:35:12 2024 +0100
@@ -1095,8 +1095,8 @@
                 SOME T' => T'
               | NONE => raise Fail "strip_shyps: bad type variable in proof term"));
         val map_ztyp =
-          #apply (ZTypes.unsynchronized_cache
-            (ZTerm.subst_type_same (ZTerm.ztyp_of o map_atyp o ZTerm.typ_of o ZTVar)));
+          ZTypes.apply_unsynchronized_cache
+            (ZTerm.subst_type_same (ZTerm.ztyp_of o map_atyp o ZTerm.typ_of o ZTVar));
 
         val zproof' = ZTerm.map_proof_types {hyps = true} map_ztyp zproof;
         val proof' = Proofterm.map_proof_types (Term.map_atyps_same map_atyp) proof;
--- a/src/Pure/zterm.ML	Mon Dec 02 18:53:45 2024 +0100
+++ b/src/Pure/zterm.ML	Mon Dec 02 20:35:12 2024 +0100
@@ -548,7 +548,7 @@
 
 fun instantiate_type_same instT =
   if ZTVars.is_empty instT then Same.same
-  else #apply (ZTypes.unsynchronized_cache (subst_type_same (Same.function (ZTVars.lookup instT))));
+  else ZTypes.apply_unsynchronized_cache (subst_type_same (Same.function (ZTVars.lookup instT)));
 
 fun instantiate_term_same typ inst =
   subst_term_same typ (Same.function (ZVars.lookup inst));
@@ -863,9 +863,7 @@
   let
     val lookup =
       if Vartab.is_empty tenv then K NONE
-      else
-        #apply (ZVars.unsynchronized_cache
-          (apsnd typ_of #> Envir.lookup envir #> Option.map zterm));
+      else ZVars.apply_unsynchronized_cache (apsnd typ_of #> Envir.lookup envir #> Option.map zterm);
 
     val normT = norm_type_same ztyp tyenv;
 
@@ -1008,8 +1006,8 @@
     val typ_operation = #typ_operation ucontext {strip_sorts = true};
     val unconstrain_typ = Same.commit typ_operation;
     val unconstrain_ztyp =
-      #apply (ZTypes.unsynchronized_cache
-        (Same.function_eq (op =) (typ_of #> unconstrain_typ #> ztyp_of)));
+      ZTypes.apply_unsynchronized_cache
+        (Same.function_eq (op =) (typ_of #> unconstrain_typ #> ztyp_of));
     val unconstrain_zterm = zterm o Term.map_types typ_operation;
     val unconstrain_proof = Same.commit (map_proof_types {hyps = true} unconstrain_ztyp);
 
@@ -1226,10 +1224,10 @@
     val typ =
       if Names.is_empty tfrees then Same.same
       else
-        #apply (ZTypes.unsynchronized_cache
+        ZTypes.apply_unsynchronized_cache
           (subst_type_same (fn ((a, i), S) =>
             if i = ~1 andalso Names.defined tfrees a then ZTVar ((a, idx), S)
-            else raise Same.SAME)));
+            else raise Same.SAME));
     val term =
       subst_term_same typ (fn ((x, i), T) =>
         if i = ~1 andalso Names.defined frees x then ZVar ((x, idx), T)
@@ -1251,10 +1249,10 @@
     let
       val tab = ZTVars.build (names |> fold (fn ((a, S), b) => ZTVars.add (((a, ~1), S), b)));
       val typ =
-        #apply (ZTypes.unsynchronized_cache (subst_type_same (fn v =>
+        ZTypes.apply_unsynchronized_cache (subst_type_same (fn v =>
           (case ZTVars.lookup tab v of
             NONE => raise Same.SAME
-          | SOME w => ZTVar w))));
+          | SOME w => ZTVar w)));
     in map_proof_types {hyps = false} typ prf end;
 
 fun legacy_freezeT_proof t prf =
@@ -1263,7 +1261,7 @@
   | SOME f =>
       let
         val tvar = ztyp_of o Same.function f;
-        val typ = #apply (ZTypes.unsynchronized_cache (subst_type_same tvar));
+        val typ = ZTypes.apply_unsynchronized_cache (subst_type_same tvar);
       in map_proof_types {hyps = false} typ prf end);
 
 
@@ -1297,7 +1295,7 @@
   if inc = 0 then Same.same
   else
     let fun tvar ((a, i), S) = if i >= 0 then ZTVar ((a, i + inc), S) else raise Same.SAME
-    in #apply (ZTypes.unsynchronized_cache (subst_type_same tvar)) end;
+    in ZTypes.apply_unsynchronized_cache (subst_type_same tvar) end;
 
 fun incr_indexes_proof inc prf =
   let
@@ -1437,8 +1435,8 @@
     val typ_cache = typ_cache thy;
 
     val typ =
-      #apply (ZTypes.unsynchronized_cache
-        (typ_of #> #typ_operation ucontext {strip_sorts = true} #> ztyp_of));
+      ZTypes.apply_unsynchronized_cache
+        (typ_of #> #typ_operation ucontext {strip_sorts = true} #> ztyp_of);
 
     val typ_sort = #typ_operation ucontext {strip_sorts = false};