tuned: more direct use of Name.context operations;
authorwenzelm
Sat, 30 Nov 2024 13:41:38 +0100
changeset 81512 c1aa8a61ee65
parent 81511 8cbc8bc6f382
child 81513 d11ed1bf0ad2
tuned: more direct use of Name.context operations;
src/HOL/Tools/Function/fun.ML
src/HOL/Tools/Quickcheck/narrowing_generators.ML
src/Pure/Build/export_theory.ML
src/Pure/Proof/proof_rewrite_rules.ML
src/Pure/axclass.ML
src/Pure/logic.ML
src/Pure/variable.ML
--- a/src/HOL/Tools/Function/fun.ML	Sat Nov 30 13:40:57 2024 +0100
+++ b/src/HOL/Tools/Function/fun.ML	Sat Nov 30 13:41:38 2024 +0100
@@ -66,8 +66,7 @@
         val n = arity_of fname
         val (argTs, rT) = chop n (binder_types fT)
           |> apsnd (fn Ts => Ts ---> body_type fT)
-
-        val qs = map Free (Name.invent_global "a" n ~~ argTs)
+        val qs = map Free (Name.invent_names_global "a" argTs)
       in
         HOLogic.mk_eq(list_comb (Free (fname, fT), qs),
           Const (\<^const_name>\<open>undefined\<close>, rT))
--- a/src/HOL/Tools/Quickcheck/narrowing_generators.ML	Sat Nov 30 13:40:57 2024 +0100
+++ b/src/HOL/Tools/Quickcheck/narrowing_generators.ML	Sat Nov 30 13:41:38 2024 +0100
@@ -72,7 +72,7 @@
 
 fun mk_partial_term_of_eq thy ty (i, (c, (_, tys))) =
   let
-    val frees = map Free (Name.invent_names_global "a" (map (K \<^typ>\<open>narrowing_term\<close>) tys))
+    val frees = map (fn a => Free (a, \<^typ>\<open>narrowing_term\<close>)) (Name.invent_global "a" (length tys))
     val narrowing_term =
       \<^term>\<open>Quickcheck_Narrowing.Narrowing_constructor\<close> $ HOLogic.mk_number \<^typ>\<open>integer\<close> i $
         HOLogic.mk_list \<^typ>\<open>narrowing_term\<close> (rev frees)
--- a/src/Pure/Build/export_theory.ML	Sat Nov 30 13:40:57 2024 +0100
+++ b/src/Pure/Build/export_theory.ML	Sat Nov 30 13:41:38 2024 +0100
@@ -263,7 +263,7 @@
         val args' = args |> filter (is_free o #1);
         val typargs' = typargs |> filter (is_free o #1);
         val used_typargs = fold (Name.declare o #1) typargs' used;
-        val sorts = Name.invent used_typargs Name.aT (length extra_shyps) ~~ extra_shyps;
+        val sorts = Name.invent_types used_typargs extra_shyps;
       in ((sorts @ typargs', args', prop), proof) end;
 
     fun standard_prop_of thm =
--- a/src/Pure/Proof/proof_rewrite_rules.ML	Sat Nov 30 13:40:57 2024 +0100
+++ b/src/Pure/Proof/proof_rewrite_rules.ML	Sat Nov 30 13:41:38 2024 +0100
@@ -211,9 +211,8 @@
   let
     fun rew_term Ts t =
       let
-        val frees =
-          map Free
-            (Name.invent (Name.build_context (Term.declare_free_names t)) "xa" (length Ts) ~~ Ts);
+        val names = Name.build_context (Term.declare_free_names t);
+        val frees = map Free (Name.invent_names names "xa" Ts);
         val t' = r (subst_bounds (frees, t));
         fun strip [] t = t
           | strip (_ :: xs) (Abs (_, _, t)) = strip xs t;
--- a/src/Pure/axclass.ML	Sat Nov 30 13:40:57 2024 +0100
+++ b/src/Pure/axclass.ML	Sat Nov 30 13:41:38 2024 +0100
@@ -280,12 +280,12 @@
     val binding =
       Binding.concealed (Binding.name (prefix arity_prefix (Logic.name_arity arity)));
 
-    val args = Name.invent_types_global Ss;
+    val args = map TFree (Name.invent_types_global Ss);
     val missing_params =
       Sign.complete_sort thy [c]
       |> maps (these o Option.map #params o try (get_info thy))
       |> filter_out (fn (const, _) => can (get_inst_param thy) (const, t))
-      |> (map o apsnd o map_atyps) (K (Type (t, map TFree args)));
+      |> (map o apsnd o map_atyps) (K (Type (t, args)));
   in
     thy
     |> Global_Theory.store_thm (binding, th)
--- a/src/Pure/logic.ML	Sat Nov 30 13:40:57 2024 +0100
+++ b/src/Pure/logic.ML	Sat Nov 30 13:41:38 2024 +0100
@@ -335,7 +335,7 @@
 fun name_arity (t, dom, c) = hd (name_arities (t, dom, [c]));
 
 fun mk_arities (t, Ss, S) =
-  let val T = Type (t, ListPair.map TFree (Name.invent_global_types (length Ss), Ss))
+  let val T = Type (t, map TFree (Name.invent_types_global Ss))
   in map (fn c => mk_of_class (T, c)) S end;
 
 fun mk_arity (t, Ss, c) = the_single (mk_arities (t, Ss, [c]));
--- a/src/Pure/variable.ML	Sat Nov 30 13:40:57 2024 +0100
+++ b/src/Pure/variable.ML	Sat Nov 30 13:41:38 2024 +0100
@@ -594,7 +594,7 @@
 
 fun invent_types Ss ctxt =
   let
-    val tfrees = Name.invent (names_of ctxt) Name.aT (length Ss) ~~ Ss;
+    val tfrees = Name.invent_types (names_of ctxt) Ss;
     val ctxt' = fold (declare_constraints o Logic.mk_type o TFree) tfrees ctxt;
   in (tfrees, ctxt') end;