clarified renaming of bounds, using Syntax_Trans.variant_bounds: avoid structures and fixed variables with syntax;
authorwenzelm
Fri, 06 Dec 2024 20:26:33 +0100
changeset 81545 6f8a56a6b391
parent 81544 dfd5f665db69
child 81546 7a1001f4c600
clarified renaming of bounds, using Syntax_Trans.variant_bounds: avoid structures and fixed variables with syntax;
src/FOL/IFOL.thy
src/HOL/HOL.thy
src/HOL/HOLCF/Cfun.thy
src/HOL/HOLCF/ex/Pattern_Match.thy
src/HOL/Hilbert_Choice.thy
src/HOL/Library/FSet.thy
src/HOL/Library/Multiset.thy
src/HOL/Probability/Probability_Measure.thy
src/HOL/Product_Type.thy
src/HOL/Set.thy
src/Pure/Isar/subgoal.ML
src/Pure/Syntax/syntax_phases.ML
src/Pure/Syntax/syntax_trans.ML
src/Pure/primitive_defs.ML
src/Pure/type_infer_context.ML
src/Pure/variable.ML
src/Tools/induct.ML
src/Tools/subtyping.ML
--- a/src/FOL/IFOL.thy	Fri Dec 06 15:20:43 2024 +0100
+++ b/src/FOL/IFOL.thy	Fri Dec 06 20:26:33 2024 +0100
@@ -105,7 +105,7 @@
 syntax_consts "_Uniq" \<rightleftharpoons> Uniq
 translations "\<exists>\<^sub>\<le>\<^sub>1x. P" \<rightleftharpoons> "CONST Uniq (\<lambda>x. P)"
 typed_print_translation \<open>
-  [(\<^const_syntax>\<open>Uniq\<close>, fn _ => Syntax_Trans.preserve_binder_abs_tr' \<^syntax_const>\<open>_Uniq\<close>)]
+  [(\<^const_syntax>\<open>Uniq\<close>, Syntax_Trans.preserve_binder_abs_tr' \<^syntax_const>\<open>_Uniq\<close>)]
 \<close> \<comment> \<open>to avoid eta-contraction of body\<close>
 
 
--- a/src/HOL/HOL.thy	Fri Dec 06 15:20:43 2024 +0100
+++ b/src/HOL/HOL.thy	Fri Dec 06 20:26:33 2024 +0100
@@ -135,7 +135,7 @@
 translations "\<exists>\<^sub>\<le>\<^sub>1x. P" \<rightleftharpoons> "CONST Uniq (\<lambda>x. P)"
 
 typed_print_translation \<open>
-  [(\<^const_syntax>\<open>Uniq\<close>, fn _ => Syntax_Trans.preserve_binder_abs_tr' \<^syntax_const>\<open>_Uniq\<close>)]
+  [(\<^const_syntax>\<open>Uniq\<close>, Syntax_Trans.preserve_binder_abs_tr' \<^syntax_const>\<open>_Uniq\<close>)]
 \<close> \<comment> \<open>to avoid eta-contraction of body\<close>
 
 
@@ -150,7 +150,7 @@
 translations "\<exists>!x. P" \<rightleftharpoons> "CONST Ex1 (\<lambda>x. P)"
 
 typed_print_translation \<open>
-  [(\<^const_syntax>\<open>Ex1\<close>, fn _ => Syntax_Trans.preserve_binder_abs_tr' \<^syntax_const>\<open>_Ex1\<close>)]
+  [(\<^const_syntax>\<open>Ex1\<close>, Syntax_Trans.preserve_binder_abs_tr' \<^syntax_const>\<open>_Ex1\<close>)]
 \<close> \<comment> \<open>to avoid eta-contraction of body\<close>
 
 
@@ -183,8 +183,8 @@
 syntax_consts "_The" \<rightleftharpoons> The
 translations "THE x. P" \<rightleftharpoons> "CONST The (\<lambda>x. P)"
 print_translation \<open>
-  [(\<^const_syntax>\<open>The\<close>, fn _ => fn [Abs abs] =>
-      let val (x, t) = Syntax_Trans.atomic_abs_tr' abs
+  [(\<^const_syntax>\<open>The\<close>, fn ctxt => fn [Abs abs] =>
+      let val (x, t) = Syntax_Trans.atomic_abs_tr' ctxt abs
       in Syntax.const \<^syntax_const>\<open>_The\<close> $ x $ t end)]
 \<close>  \<comment> \<open>To avoid eta-contraction of body\<close>
 
--- a/src/HOL/HOLCF/Cfun.thy	Fri Dec 06 15:20:43 2024 +0100
+++ b/src/HOL/HOLCF/Cfun.thy	Fri Dec 06 20:26:33 2024 +0100
@@ -39,8 +39,8 @@
 \<close>
 
 print_translation \<open>
-  [(\<^const_syntax>\<open>Abs_cfun\<close>, fn _ => fn [Abs abs] =>
-      let val (x, t) = Syntax_Trans.atomic_abs_tr' abs
+  [(\<^const_syntax>\<open>Abs_cfun\<close>, fn ctxt => fn [Abs abs] =>
+      let val (x, t) = Syntax_Trans.atomic_abs_tr' ctxt abs
       in Syntax.const \<^syntax_const>\<open>_cabs\<close> $ x $ t end)]
 \<close>  \<comment> \<open>To avoid eta-contraction of body\<close>
 
--- a/src/HOL/HOLCF/ex/Pattern_Match.thy	Fri Dec 06 15:20:43 2024 +0100
+++ b/src/HOL/HOLCF/ex/Pattern_Match.thy	Fri Dec 06 20:26:33 2024 +0100
@@ -142,29 +142,29 @@
 
 print_translation \<open>
   let
-    fun dest_LAM (Const (\<^const_syntax>\<open>Rep_cfun\<close>,_) $ Const (\<^const_syntax>\<open>unit_when\<close>,_) $ t) =
+    fun dest_LAM _ (Const (\<^const_syntax>\<open>Rep_cfun\<close>,_) $ Const (\<^const_syntax>\<open>unit_when\<close>,_) $ t) =
           (Syntax.const \<^syntax_const>\<open>_noargs\<close>, t)
-    |   dest_LAM (Const (\<^const_syntax>\<open>Rep_cfun\<close>,_) $ Const (\<^const_syntax>\<open>csplit\<close>,_) $ t) =
+    |   dest_LAM ctxt (Const (\<^const_syntax>\<open>Rep_cfun\<close>,_) $ Const (\<^const_syntax>\<open>csplit\<close>,_) $ t) =
           let
-            val (v1, t1) = dest_LAM t;
-            val (v2, t2) = dest_LAM t1;
+            val (v1, t1) = dest_LAM ctxt t;
+            val (v2, t2) = dest_LAM ctxt t1;
           in (Syntax.const \<^syntax_const>\<open>_args\<close> $ v1 $ v2, t2) end
-    |   dest_LAM (Const (\<^const_syntax>\<open>Abs_cfun\<close>,_) $ t) =
+    |   dest_LAM ctxt (Const (\<^const_syntax>\<open>Abs_cfun\<close>,_) $ t) =
           let
             val abs =
               case t of Abs abs => abs
                 | _ => ("x", dummyT, incr_boundvars 1 t $ Bound 0);
-            val (x, t') = Syntax_Trans.atomic_abs_tr' abs;
+            val (x, t') = Syntax_Trans.atomic_abs_tr' ctxt abs;
           in (Syntax.const \<^syntax_const>\<open>_variable\<close> $ x, t') end
-    |   dest_LAM _ = raise Match; (* too few vars: abort translation *)
+    |   dest_LAM _ _ = raise Match; (* too few vars: abort translation *)
 
-    fun Case1_tr' [Const(\<^const_syntax>\<open>branch\<close>,_) $ p, r] =
-          let val (v, t) = dest_LAM r in
+    fun Case1_tr' ctxt [Const(\<^const_syntax>\<open>branch\<close>,_) $ p, r] =
+          let val (v, t) = dest_LAM ctxt r in
             Syntax.const \<^syntax_const>\<open>_Case1\<close> $
               (Syntax.const \<^syntax_const>\<open>_match\<close> $ p $ v) $ t
           end;
 
-  in [(\<^const_syntax>\<open>Rep_cfun\<close>, K Case1_tr')] end
+  in [(\<^const_syntax>\<open>Rep_cfun\<close>, Case1_tr')] end
 \<close>
 
 translations
--- a/src/HOL/Hilbert_Choice.thy	Fri Dec 06 15:20:43 2024 +0100
+++ b/src/HOL/Hilbert_Choice.thy	Fri Dec 06 20:26:33 2024 +0100
@@ -29,8 +29,8 @@
   "SOME x. P" \<rightleftharpoons> "CONST Eps (\<lambda>x. P)"
 
 print_translation \<open>
-  [(\<^const_syntax>\<open>Eps\<close>, fn _ => fn [Abs abs] =>
-      let val (x, t) = Syntax_Trans.atomic_abs_tr' abs
+  [(\<^const_syntax>\<open>Eps\<close>, fn ctxt => fn [Abs abs] =>
+      let val (x, t) = Syntax_Trans.atomic_abs_tr' ctxt abs
       in Syntax.const \<^syntax_const>\<open>_Eps\<close> $ x $ t end)]
 \<close> \<comment> \<open>to avoid eta-contraction of body\<close>
 
--- a/src/HOL/Library/FSet.thy	Fri Dec 06 15:20:43 2024 +0100
+++ b/src/HOL/Library/FSet.thy	Fri Dec 06 20:26:33 2024 +0100
@@ -216,8 +216,8 @@
   "\<exists>!x|\<in>|A. P" \<rightharpoonup> "\<exists>!x. x |\<in>| A \<and> P"
 
 typed_print_translation \<open>
- [(\<^const_syntax>\<open>fBall\<close>, fn _ => Syntax_Trans.preserve_binder_abs2_tr' \<^syntax_const>\<open>_fBall\<close>),
-  (\<^const_syntax>\<open>fBex\<close>, fn _ => Syntax_Trans.preserve_binder_abs2_tr' \<^syntax_const>\<open>_fBex\<close>)]
+ [(\<^const_syntax>\<open>fBall\<close>, Syntax_Trans.preserve_binder_abs2_tr' \<^syntax_const>\<open>_fBall\<close>),
+  (\<^const_syntax>\<open>fBex\<close>, Syntax_Trans.preserve_binder_abs2_tr' \<^syntax_const>\<open>_fBex\<close>)]
 \<close> \<comment> \<open>to avoid eta-contraction of body\<close>
 
 syntax
--- a/src/HOL/Library/Multiset.thy	Fri Dec 06 15:20:43 2024 +0100
+++ b/src/HOL/Library/Multiset.thy	Fri Dec 06 20:26:33 2024 +0100
@@ -181,8 +181,8 @@
   "\<exists>x\<in>#A. P" \<rightleftharpoons> "CONST Multiset.Bex A (\<lambda>x. P)"
 
 typed_print_translation \<open>
- [(\<^const_syntax>\<open>Multiset.Ball\<close>, fn _ => Syntax_Trans.preserve_binder_abs2_tr' \<^syntax_const>\<open>_MBall\<close>),
-  (\<^const_syntax>\<open>Multiset.Bex\<close>, fn _ => Syntax_Trans.preserve_binder_abs2_tr' \<^syntax_const>\<open>_MBex\<close>)]
+ [(\<^const_syntax>\<open>Multiset.Ball\<close>, Syntax_Trans.preserve_binder_abs2_tr' \<^syntax_const>\<open>_MBall\<close>),
+  (\<^const_syntax>\<open>Multiset.Bex\<close>, Syntax_Trans.preserve_binder_abs2_tr' \<^syntax_const>\<open>_MBex\<close>)]
 \<close> \<comment> \<open>to avoid eta-contraction of body\<close>
 
 lemma count_eq_zero_iff:
--- a/src/HOL/Probability/Probability_Measure.thy	Fri Dec 06 15:20:43 2024 +0100
+++ b/src/HOL/Probability/Probability_Measure.thy	Fri Dec 06 20:26:33 2024 +0100
@@ -283,7 +283,7 @@
       end
     | unnest_tuples pat = pat
 
-    fun tr' [sig_alg, Const (\<^const_syntax>\<open>Collect\<close>, _) $ t] =
+    fun tr' ctxt [sig_alg, Const (\<^const_syntax>\<open>Collect\<close>, _) $ t] =
       let
         val bound_dummyT = Const (\<^syntax_const>\<open>_bound\<close>, dummyT)
 
@@ -300,7 +300,7 @@
             end
         | go pattern elem (Abs abs) =
             let
-              val (x as (_ $ tx), t) = Syntax_Trans.atomic_abs_tr' abs
+              val (x as (_ $ tx), t) = Syntax_Trans.atomic_abs_tr' ctxt abs
             in
               go ((x, 0) :: pattern) (bound_dummyT $ tx :: elem) t
             end
@@ -313,7 +313,7 @@
         go [] [] t
       end
   in
-    [(\<^const_syntax>\<open>Sigma_Algebra.measure\<close>, K tr')]
+    [(\<^const_syntax>\<open>Sigma_Algebra.measure\<close>, tr')]
   end
 \<close>
 
--- a/src/HOL/Product_Type.thy	Fri Dec 06 15:20:43 2024 +0100
+++ b/src/HOL/Product_Type.thy	Fri Dec 06 20:26:33 2024 +0100
@@ -315,34 +315,34 @@
 
 typed_print_translation \<open>
   let
-    fun case_prod_guess_names_tr' T [Abs (x, _, Abs _)] = raise Match
-      | case_prod_guess_names_tr' T [Abs (x, xT, t)] =
+    fun case_prod_guess_names_tr' _ T [Abs (x, _, Abs _)] = raise Match
+      | case_prod_guess_names_tr' ctxt T [Abs (x, xT, t)] =
           (case (head_of t) of
             Const (\<^const_syntax>\<open>case_prod\<close>, _) => raise Match
           | _ =>
             let
               val (_ :: yT :: _) = binder_types (domain_type T) handle Bind => raise Match;
-              val (y, t') = Syntax_Trans.atomic_abs_tr' ("y", yT, incr_boundvars 1 t $ Bound 0);
-              val (x', t'') = Syntax_Trans.atomic_abs_tr' (x, xT, t');
+              val (y, t') = Syntax_Trans.atomic_abs_tr' ctxt ("y", yT, incr_boundvars 1 t $ Bound 0);
+              val (x', t'') = Syntax_Trans.atomic_abs_tr' ctxt (x, xT, t');
             in
               Syntax.const \<^syntax_const>\<open>_abs\<close> $
                 (Syntax.const \<^syntax_const>\<open>_pattern\<close> $ x' $ y) $ t''
             end)
-      | case_prod_guess_names_tr' T [t] =
+      | case_prod_guess_names_tr' ctxt T [t] =
           (case head_of t of
             Const (\<^const_syntax>\<open>case_prod\<close>, _) => raise Match
           | _ =>
             let
               val (xT :: yT :: _) = binder_types (domain_type T) handle Bind => raise Match;
               val (y, t') =
-                Syntax_Trans.atomic_abs_tr' ("y", yT, incr_boundvars 2 t $ Bound 1 $ Bound 0);
-              val (x', t'') = Syntax_Trans.atomic_abs_tr' ("x", xT, t');
+                Syntax_Trans.atomic_abs_tr' ctxt ("y", yT, incr_boundvars 2 t $ Bound 1 $ Bound 0);
+              val (x', t'') = Syntax_Trans.atomic_abs_tr' ctxt ("x", xT, t');
             in
               Syntax.const \<^syntax_const>\<open>_abs\<close> $
                 (Syntax.const \<^syntax_const>\<open>_pattern\<close> $ x' $ y) $ t''
             end)
-      | case_prod_guess_names_tr' _ _ = raise Match;
-  in [(\<^const_syntax>\<open>case_prod\<close>, K case_prod_guess_names_tr')] end
+      | case_prod_guess_names_tr' _ _ _ = raise Match;
+  in [(\<^const_syntax>\<open>case_prod\<close>, case_prod_guess_names_tr')] end
 \<close>
 
 text \<open>Reconstruct pattern from (nested) \<^const>\<open>case_prod\<close>s,
@@ -351,39 +351,39 @@
 
 print_translation \<open>
   let
-    fun case_prod_tr' [Abs (x, T, t as (Abs abs))] =
+    fun case_prod_tr' ctxt [Abs (x, T, t as (Abs abs))] =
           (* case_prod (\<lambda>x y. t) \<Rightarrow> \<lambda>(x, y) t *)
           let
-            val (y, t') = Syntax_Trans.atomic_abs_tr' abs;
-            val (x', t'') = Syntax_Trans.atomic_abs_tr' (x, T, t');
+            val (y, t') = Syntax_Trans.atomic_abs_tr' ctxt abs;
+            val (x', t'') = Syntax_Trans.atomic_abs_tr' ctxt (x, T, t');
           in
             Syntax.const \<^syntax_const>\<open>_abs\<close> $
               (Syntax.const \<^syntax_const>\<open>_pattern\<close> $ x' $ y) $ t''
           end
-      | case_prod_tr' [Abs (x, T, (s as Const (\<^const_syntax>\<open>case_prod\<close>, _) $ t))] =
+      | case_prod_tr' ctxt [Abs (x, T, (s as Const (\<^const_syntax>\<open>case_prod\<close>, _) $ t))] =
           (* case_prod (\<lambda>x. (case_prod (\<lambda>y z. t))) \<Rightarrow> \<lambda>(x, y, z). t *)
           let
             val Const (\<^syntax_const>\<open>_abs\<close>, _) $
               (Const (\<^syntax_const>\<open>_pattern\<close>, _) $ y $ z) $ t' =
-                case_prod_tr' [t];
-            val (x', t'') = Syntax_Trans.atomic_abs_tr' (x, T, t');
+                case_prod_tr' ctxt [t];
+            val (x', t'') = Syntax_Trans.atomic_abs_tr' ctxt (x, T, t');
           in
             Syntax.const \<^syntax_const>\<open>_abs\<close> $
               (Syntax.const \<^syntax_const>\<open>_pattern\<close> $ x' $
                 (Syntax.const \<^syntax_const>\<open>_patterns\<close> $ y $ z)) $ t''
           end
-      | case_prod_tr' [Const (\<^const_syntax>\<open>case_prod\<close>, _) $ t] =
+      | case_prod_tr' ctxt [Const (\<^const_syntax>\<open>case_prod\<close>, _) $ t] =
           (* case_prod (case_prod (\<lambda>x y z. t)) \<Rightarrow> \<lambda>((x, y), z). t *)
-          case_prod_tr' [(case_prod_tr' [t])]
+          case_prod_tr' ctxt [(case_prod_tr' ctxt [t])]
             (* inner case_prod_tr' creates next pattern *)
-      | case_prod_tr' [Const (\<^syntax_const>\<open>_abs\<close>, _) $ x_y $ Abs abs] =
+      | case_prod_tr' ctxt [Const (\<^syntax_const>\<open>_abs\<close>, _) $ x_y $ Abs abs] =
           (* case_prod (\<lambda>pttrn z. t) \<Rightarrow> \<lambda>(pttrn, z). t *)
-          let val (z, t) = Syntax_Trans.atomic_abs_tr' abs in
+          let val (z, t) = Syntax_Trans.atomic_abs_tr' ctxt abs in
             Syntax.const \<^syntax_const>\<open>_abs\<close> $
               (Syntax.const \<^syntax_const>\<open>_pattern\<close> $ x_y $ z) $ t
           end
-      | case_prod_tr' _ = raise Match;
-  in [(\<^const_syntax>\<open>case_prod\<close>, K case_prod_tr')] end
+      | case_prod_tr' _ _ = raise Match;
+  in [(\<^const_syntax>\<open>case_prod\<close>, case_prod_tr')] end
 \<close>
 
 
--- a/src/HOL/Set.thy	Fri Dec 06 15:20:43 2024 +0100
+++ b/src/HOL/Set.thy	Fri Dec 06 20:26:33 2024 +0100
@@ -324,8 +324,8 @@
 \<close>
 
 typed_print_translation \<open>
- [(\<^const_syntax>\<open>Ball\<close>, fn _ => Syntax_Trans.preserve_binder_abs2_tr' \<^syntax_const>\<open>_Ball\<close>),
-  (\<^const_syntax>\<open>Bex\<close>, fn _ => Syntax_Trans.preserve_binder_abs2_tr' \<^syntax_const>\<open>_Bex\<close>)]
+ [(\<^const_syntax>\<open>Ball\<close>, Syntax_Trans.preserve_binder_abs2_tr' \<^syntax_const>\<open>_Ball\<close>),
+  (\<^const_syntax>\<open>Bex\<close>, Syntax_Trans.preserve_binder_abs2_tr' \<^syntax_const>\<open>_Bex\<close>)]
 \<close> \<comment> \<open>to avoid eta-contraction of body\<close>
 
 print_translation \<open>
@@ -348,7 +348,7 @@
       if check (P, 0) then tr' P
       else
         let
-          val (x as _ $ Free(xN, _), t) = Syntax_Trans.atomic_abs_tr' abs;
+          val (x as _ $ Free(xN, _), t) = Syntax_Trans.atomic_abs_tr' ctxt abs;
           val M = Syntax.const \<^syntax_const>\<open>_Coll\<close> $ x $ t;
         in
           case t of
--- a/src/Pure/Isar/subgoal.ML	Fri Dec 06 15:20:43 2024 +0100
+++ b/src/Pure/Isar/subgoal.ML	Fri Dec 06 20:26:33 2024 +0100
@@ -171,7 +171,7 @@
     val subgoal = #1 (Logic.dest_implies (Thm.prop_of st));
     val subgoal_params =
       map (apfst (Name.internal o Name.clean)) (Term.strip_all_vars subgoal)
-      |> Term.variant_bounds subgoal |> map #1;
+      |> Syntax_Trans.variant_bounds ctxt subgoal |> map #1;
 
     val n = length subgoal_params;
     val m = length raw_param_specs;
--- a/src/Pure/Syntax/syntax_phases.ML	Fri Dec 06 15:20:43 2024 +0100
+++ b/src/Pure/Syntax/syntax_phases.ML	Fri Dec 06 20:26:33 2024 +0100
@@ -735,13 +735,18 @@
 val typing_elem = YXML.output_markup_elem Markup.typing;
 val sorting_elem = YXML.output_markup_elem Markup.sorting;
 
-val exclude_consts =
+fun exclude_consts ast ctxt =
   let
-    fun exclude (Ast.Appl [Ast.Constant "_bound", Ast.Variable x]) = Symset.insert x
+    val s = the_default "" (Syntax_Trans.default_struct ctxt);
+
+    fun exclude (Ast.Appl [Ast.Constant "_struct", Ast.Constant "_indexdefault"]) = Symset.insert s
+      | exclude (Ast.Constant c) =
+          if Lexicon.is_fixed c then Symset.insert (Lexicon.unmark_fixed c) else I
+      | exclude (Ast.Appl [Ast.Constant "_bound", Ast.Variable x]) = Symset.insert x
       | exclude (Ast.Appl [Ast.Constant "_free", Ast.Variable x]) = Symset.insert x
       | exclude (Ast.Appl asts) = fold exclude asts
       | exclude _ = I;
-  in Proof_Context.exclude_consts o Symset.build o exclude end;
+  in Proof_Context.exclude_consts (Symset.build (exclude ast)) ctxt end;
 
 fun unparse_t t_to_ast pretty_flags language_markup ctxt0 t =
   let
--- a/src/Pure/Syntax/syntax_trans.ML	Fri Dec 06 15:20:43 2024 +0100
+++ b/src/Pure/Syntax/syntax_trans.ML	Fri Dec 06 20:26:33 2024 +0100
@@ -31,13 +31,14 @@
   val applC_ast_tr': Ast.ast * Ast.ast list -> Ast.ast
   val mark_bound_abs: string * typ -> term
   val mark_bound_body: string * typ -> term
-  val bound_vars: (string * typ) list -> term -> term
+  val variant_bounds: Proof.context -> term -> (string * 'a) list -> (string * 'a) list
+  val bound_vars: Proof.context -> (string * typ) list -> term -> term
   val abs_tr': Proof.context -> term -> term
-  val atomic_abs_tr': string * typ * term -> term * term
+  val atomic_abs_tr': Proof.context -> string * typ * term -> term * term
   val const_abs_tr': term -> term
   val mk_binder_tr': string * string -> string * (Proof.context -> term list -> term)
-  val preserve_binder_abs_tr': string -> typ -> term list -> term
-  val preserve_binder_abs2_tr': string -> typ -> term list -> term
+  val preserve_binder_abs_tr': string -> Proof.context -> typ -> term list -> term
+  val preserve_binder_abs2_tr': string -> Proof.context -> typ -> term list -> term
   val print_abs: string * typ * term -> string * term
   val dependent_tr': string * string -> term list -> term
   val antiquote_tr': string -> term -> term
@@ -76,7 +77,6 @@
     (print_mode_value ()) <> SOME type_bracketsN;
 
 
-
 (** parse (ast) translations **)
 
 (* strip_positions *)
@@ -304,14 +304,27 @@
 fun mark_bound_abs (x, T) = Const ("_bound", T --> T) $ Free (x, T);
 fun mark_bound_body (x, T) = Const ("_bound", dummyT) $ Free (x, T);
 
-fun bound_vars vars body =
-  subst_bounds (map mark_bound_abs (rev (Term.variant_bounds body vars)), body);
+fun variant_bounds ctxt t =
+  let
+    val s = the_default "" (default_struct ctxt);
 
-fun strip_abss vars_of body_of tm =
+    fun declare (Const ("_struct", _) $ Const ("_indexdefault", _)) = Name.declare s
+      | declare (Const (c, _)) =
+          if Lexicon.is_fixed c then Name.declare (Lexicon.unmark_fixed c) else I
+      | declare (Free (x, _)) = Name.declare x
+      | declare (t $ u) = declare t #> declare u
+      | declare (Abs (_, _, t)) = declare t
+      | declare _ = I;
+  in Name.variant_names_build (declare t) end;
+
+fun bound_vars ctxt vars body =
+  subst_bounds (map mark_bound_abs (rev (variant_bounds ctxt body vars)), body);
+
+fun strip_abss ctxt vars_of body_of tm =
   let
     val vars = vars_of tm;
     val body = body_of tm;
-    val new_vars = Term.variant_bounds body vars;
+    val new_vars = variant_bounds ctxt body vars;
     fun subst (x, T) b =
       if Name.is_internal x andalso not (Term.is_dependent b)
       then (Const ("_idtdummy", T), incr_boundvars ~1 b)
@@ -322,10 +335,10 @@
 
 fun abs_tr' ctxt tm =
   uncurry (fold_rev (fn x => fn t => Syntax.const "_abs" $ x $ t))
-    (strip_abss strip_abs_vars strip_abs_body (eta_contr ctxt tm));
+    (strip_abss ctxt strip_abs_vars strip_abs_body (eta_contr ctxt tm));
 
-fun atomic_abs_tr' (x, T, t) =
-  let val xT = singleton (Term.variant_bounds t) (x, T)
+fun atomic_abs_tr' ctxt (x, T, t) =
+  let val xT = singleton (variant_bounds ctxt t) (x, T)
   in (mark_bound_abs xT, subst_bound (mark_bound_body xT, t)) end;
 
 fun abs_ast_tr' asts =
@@ -349,21 +362,21 @@
       | mk_idts [idt] = idt
       | mk_idts (idt :: idts) = Syntax.const "_idts" $ idt $ mk_idts idts;
 
-    fun tr' t =
+    fun tr' ctxt t =
       let
-        val (xs, bd) = strip_abss (strip_qnt_vars name) (strip_qnt_body name) t;
+        val (xs, bd) = strip_abss ctxt (strip_qnt_vars name) (strip_qnt_body name) t;
       in Syntax.const syn $ mk_idts xs $ bd end;
 
-    fun binder_tr' (t :: ts) = Term.list_comb (tr' (Syntax.const name $ t), ts)
-      | binder_tr' [] = raise Match;
-  in (name, fn _ => binder_tr') end;
+    fun binder_tr' ctxt (t :: ts) = Term.list_comb (tr' ctxt (Syntax.const name $ t), ts)
+      | binder_tr' _ [] = raise Match;
+  in (name, binder_tr') end;
 
-fun preserve_binder_abs_tr' syn ty (Abs abs :: ts) =
-  let val (x, t) = atomic_abs_tr' abs
+fun preserve_binder_abs_tr' syn ctxt ty (Abs abs :: ts) =
+  let val (x, t) = atomic_abs_tr' ctxt abs
   in list_comb (Const (syn, ty) $ x $ t, ts) end;
 
-fun preserve_binder_abs2_tr' syn ty (A :: Abs abs :: ts) =
-  let val (x, t) = atomic_abs_tr' abs
+fun preserve_binder_abs2_tr' syn ctxt ty (A :: Abs abs :: ts) =
+  let val (x, t) = atomic_abs_tr' ctxt abs
   in list_comb (Const (syn, ty) $ x $ A $ t, ts) end;
 
 
--- a/src/Pure/primitive_defs.ML	Fri Dec 06 15:20:43 2024 +0100
+++ b/src/Pure/primitive_defs.ML	Fri Dec 06 20:26:33 2024 +0100
@@ -31,7 +31,7 @@
     val eq_body = Term.strip_all_body eq;
 
     val display_terms =
-      commas_quote o map (Syntax.string_of_term ctxt o Syntax_Trans.bound_vars eq_vars);
+      commas_quote o map (Syntax.string_of_term ctxt o Syntax_Trans.bound_vars ctxt eq_vars);
     val display_types = commas_quote o map (Syntax.string_of_typ ctxt);
 
     val (raw_lhs, rhs) = Logic.dest_equals eq_body handle TERM _ => err "Not a meta-equality (\<equiv>)";
--- a/src/Pure/type_infer_context.ML	Fri Dec 06 15:20:43 2024 +0100
+++ b/src/Pure/type_infer_context.ML	Fri Dec 06 20:26:33 2024 +0100
@@ -248,7 +248,7 @@
         val (Ts_bTs', ts') = Type_Infer.finish ctxt tye (Ts @ map snd bs, ts);
         val (Ts', Ts'') = chop (length Ts) Ts_bTs';
         fun prep t =
-          let val xs = rev (Term.variant_bounds t (rev (map fst bs ~~ Ts'')))
+          let val xs = rev (Syntax_Trans.variant_bounds ctxt t (rev (map fst bs ~~ Ts'')))
           in Term.subst_bounds (map Syntax_Trans.mark_bound_abs xs, t) end;
       in (map prep ts', Ts') end;
 
--- a/src/Pure/variable.ML	Fri Dec 06 15:20:43 2024 +0100
+++ b/src/Pure/variable.ML	Fri Dec 06 20:26:33 2024 +0100
@@ -705,7 +705,7 @@
 
 fun focus_params bindings t ctxt =
   let
-    val ps = Term.variant_bounds t (Term.strip_all_vars t);
+    val ps = Syntax_Trans.variant_bounds ctxt t (Term.strip_all_vars t);
     val (xs, Ts) = split_list ps;
     val (xs', ctxt') =
       (case bindings of
--- a/src/Tools/induct.ML	Fri Dec 06 15:20:43 2024 +0100
+++ b/src/Tools/induct.ML	Fri Dec 06 20:26:33 2024 +0100
@@ -607,7 +607,7 @@
   let
     val maxidx = Thm.maxidx_of st;
     val goal = Thm.term_of (Thm.cprem_of st i);  (*exception Subscript*)
-    val params = Term.variant_bounds goal (Logic.strip_params goal);
+    val params = Syntax_Trans.variant_bounds ctxt goal (Logic.strip_params goal);
   in
     if not (null params) then
       (warning ("Cannot determine rule instantiation due to pending parameter(s): " ^
--- a/src/Tools/subtyping.ML	Fri Dec 06 15:20:43 2024 +0100
+++ b/src/Tools/subtyping.ML	Fri Dec 06 20:26:33 2024 +0100
@@ -244,7 +244,7 @@
     val (Ts_bTs', ts') = Type_Infer.finish ctxt tye (Ts @ map snd bs, ts);
     val (Ts', Ts'') = chop (length Ts) Ts_bTs';
     fun prep t =
-      let val xs = rev (Term.variant_bounds t (rev (map fst bs ~~ Ts'')))
+      let val xs = rev (Syntax_Trans.variant_bounds ctxt t (rev (map fst bs ~~ Ts'')))
       in Term.subst_bounds (map Syntax_Trans.mark_bound_abs xs, t) end;
   in (map prep ts', Ts') end;