# HG changeset patch # User wenzelm # Date 1733513193 -3600 # Node ID 6f8a56a6b3916286cfeb2d716eea811997863cff # Parent dfd5f665db696e048938fb2a6b14e6fd38cb9eb5 clarified renaming of bounds, using Syntax_Trans.variant_bounds: avoid structures and fixed variables with syntax; diff -r dfd5f665db69 -r 6f8a56a6b391 src/FOL/IFOL.thy --- 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" \ Uniq translations "\\<^sub>\\<^sub>1x. P" \ "CONST Uniq (\x. P)" typed_print_translation \ - [(\<^const_syntax>\Uniq\, fn _ => Syntax_Trans.preserve_binder_abs_tr' \<^syntax_const>\_Uniq\)] + [(\<^const_syntax>\Uniq\, Syntax_Trans.preserve_binder_abs_tr' \<^syntax_const>\_Uniq\)] \ \ \to avoid eta-contraction of body\ diff -r dfd5f665db69 -r 6f8a56a6b391 src/HOL/HOL.thy --- 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 "\\<^sub>\\<^sub>1x. P" \ "CONST Uniq (\x. P)" typed_print_translation \ - [(\<^const_syntax>\Uniq\, fn _ => Syntax_Trans.preserve_binder_abs_tr' \<^syntax_const>\_Uniq\)] + [(\<^const_syntax>\Uniq\, Syntax_Trans.preserve_binder_abs_tr' \<^syntax_const>\_Uniq\)] \ \ \to avoid eta-contraction of body\ @@ -150,7 +150,7 @@ translations "\!x. P" \ "CONST Ex1 (\x. P)" typed_print_translation \ - [(\<^const_syntax>\Ex1\, fn _ => Syntax_Trans.preserve_binder_abs_tr' \<^syntax_const>\_Ex1\)] + [(\<^const_syntax>\Ex1\, Syntax_Trans.preserve_binder_abs_tr' \<^syntax_const>\_Ex1\)] \ \ \to avoid eta-contraction of body\ @@ -183,8 +183,8 @@ syntax_consts "_The" \ The translations "THE x. P" \ "CONST The (\x. P)" print_translation \ - [(\<^const_syntax>\The\, fn _ => fn [Abs abs] => - let val (x, t) = Syntax_Trans.atomic_abs_tr' abs + [(\<^const_syntax>\The\, fn ctxt => fn [Abs abs] => + let val (x, t) = Syntax_Trans.atomic_abs_tr' ctxt abs in Syntax.const \<^syntax_const>\_The\ $ x $ t end)] \ \ \To avoid eta-contraction of body\ diff -r dfd5f665db69 -r 6f8a56a6b391 src/HOL/HOLCF/Cfun.thy --- 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 @@ \ print_translation \ - [(\<^const_syntax>\Abs_cfun\, fn _ => fn [Abs abs] => - let val (x, t) = Syntax_Trans.atomic_abs_tr' abs + [(\<^const_syntax>\Abs_cfun\, fn ctxt => fn [Abs abs] => + let val (x, t) = Syntax_Trans.atomic_abs_tr' ctxt abs in Syntax.const \<^syntax_const>\_cabs\ $ x $ t end)] \ \ \To avoid eta-contraction of body\ diff -r dfd5f665db69 -r 6f8a56a6b391 src/HOL/HOLCF/ex/Pattern_Match.thy --- 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 \ let - fun dest_LAM (Const (\<^const_syntax>\Rep_cfun\,_) $ Const (\<^const_syntax>\unit_when\,_) $ t) = + fun dest_LAM _ (Const (\<^const_syntax>\Rep_cfun\,_) $ Const (\<^const_syntax>\unit_when\,_) $ t) = (Syntax.const \<^syntax_const>\_noargs\, t) - | dest_LAM (Const (\<^const_syntax>\Rep_cfun\,_) $ Const (\<^const_syntax>\csplit\,_) $ t) = + | dest_LAM ctxt (Const (\<^const_syntax>\Rep_cfun\,_) $ Const (\<^const_syntax>\csplit\,_) $ 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>\_args\ $ v1 $ v2, t2) end - | dest_LAM (Const (\<^const_syntax>\Abs_cfun\,_) $ t) = + | dest_LAM ctxt (Const (\<^const_syntax>\Abs_cfun\,_) $ 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>\_variable\ $ 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>\branch\,_) $ p, r] = - let val (v, t) = dest_LAM r in + fun Case1_tr' ctxt [Const(\<^const_syntax>\branch\,_) $ p, r] = + let val (v, t) = dest_LAM ctxt r in Syntax.const \<^syntax_const>\_Case1\ $ (Syntax.const \<^syntax_const>\_match\ $ p $ v) $ t end; - in [(\<^const_syntax>\Rep_cfun\, K Case1_tr')] end + in [(\<^const_syntax>\Rep_cfun\, Case1_tr')] end \ translations diff -r dfd5f665db69 -r 6f8a56a6b391 src/HOL/Hilbert_Choice.thy --- 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" \ "CONST Eps (\x. P)" print_translation \ - [(\<^const_syntax>\Eps\, fn _ => fn [Abs abs] => - let val (x, t) = Syntax_Trans.atomic_abs_tr' abs + [(\<^const_syntax>\Eps\, fn ctxt => fn [Abs abs] => + let val (x, t) = Syntax_Trans.atomic_abs_tr' ctxt abs in Syntax.const \<^syntax_const>\_Eps\ $ x $ t end)] \ \ \to avoid eta-contraction of body\ diff -r dfd5f665db69 -r 6f8a56a6b391 src/HOL/Library/FSet.thy --- 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 @@ "\!x|\|A. P" \ "\!x. x |\| A \ P" typed_print_translation \ - [(\<^const_syntax>\fBall\, fn _ => Syntax_Trans.preserve_binder_abs2_tr' \<^syntax_const>\_fBall\), - (\<^const_syntax>\fBex\, fn _ => Syntax_Trans.preserve_binder_abs2_tr' \<^syntax_const>\_fBex\)] + [(\<^const_syntax>\fBall\, Syntax_Trans.preserve_binder_abs2_tr' \<^syntax_const>\_fBall\), + (\<^const_syntax>\fBex\, Syntax_Trans.preserve_binder_abs2_tr' \<^syntax_const>\_fBex\)] \ \ \to avoid eta-contraction of body\ syntax diff -r dfd5f665db69 -r 6f8a56a6b391 src/HOL/Library/Multiset.thy --- 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 @@ "\x\#A. P" \ "CONST Multiset.Bex A (\x. P)" typed_print_translation \ - [(\<^const_syntax>\Multiset.Ball\, fn _ => Syntax_Trans.preserve_binder_abs2_tr' \<^syntax_const>\_MBall\), - (\<^const_syntax>\Multiset.Bex\, fn _ => Syntax_Trans.preserve_binder_abs2_tr' \<^syntax_const>\_MBex\)] + [(\<^const_syntax>\Multiset.Ball\, Syntax_Trans.preserve_binder_abs2_tr' \<^syntax_const>\_MBall\), + (\<^const_syntax>\Multiset.Bex\, Syntax_Trans.preserve_binder_abs2_tr' \<^syntax_const>\_MBex\)] \ \ \to avoid eta-contraction of body\ lemma count_eq_zero_iff: diff -r dfd5f665db69 -r 6f8a56a6b391 src/HOL/Probability/Probability_Measure.thy --- 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>\Collect\, _) $ t] = + fun tr' ctxt [sig_alg, Const (\<^const_syntax>\Collect\, _) $ t] = let val bound_dummyT = Const (\<^syntax_const>\_bound\, 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>\Sigma_Algebra.measure\, K tr')] + [(\<^const_syntax>\Sigma_Algebra.measure\, tr')] end \ diff -r dfd5f665db69 -r 6f8a56a6b391 src/HOL/Product_Type.thy --- 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 \ 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>\case_prod\, _) => 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>\_abs\ $ (Syntax.const \<^syntax_const>\_pattern\ $ 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>\case_prod\, _) => 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>\_abs\ $ (Syntax.const \<^syntax_const>\_pattern\ $ x' $ y) $ t'' end) - | case_prod_guess_names_tr' _ _ = raise Match; - in [(\<^const_syntax>\case_prod\, K case_prod_guess_names_tr')] end + | case_prod_guess_names_tr' _ _ _ = raise Match; + in [(\<^const_syntax>\case_prod\, case_prod_guess_names_tr')] end \ text \Reconstruct pattern from (nested) \<^const>\case_prod\s, @@ -351,39 +351,39 @@ print_translation \ 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 (\x y. t) \ \(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>\_abs\ $ (Syntax.const \<^syntax_const>\_pattern\ $ x' $ y) $ t'' end - | case_prod_tr' [Abs (x, T, (s as Const (\<^const_syntax>\case_prod\, _) $ t))] = + | case_prod_tr' ctxt [Abs (x, T, (s as Const (\<^const_syntax>\case_prod\, _) $ t))] = (* case_prod (\x. (case_prod (\y z. t))) \ \(x, y, z). t *) let val Const (\<^syntax_const>\_abs\, _) $ (Const (\<^syntax_const>\_pattern\, _) $ 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>\_abs\ $ (Syntax.const \<^syntax_const>\_pattern\ $ x' $ (Syntax.const \<^syntax_const>\_patterns\ $ y $ z)) $ t'' end - | case_prod_tr' [Const (\<^const_syntax>\case_prod\, _) $ t] = + | case_prod_tr' ctxt [Const (\<^const_syntax>\case_prod\, _) $ t] = (* case_prod (case_prod (\x y z. t)) \ \((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>\_abs\, _) $ x_y $ Abs abs] = + | case_prod_tr' ctxt [Const (\<^syntax_const>\_abs\, _) $ x_y $ Abs abs] = (* case_prod (\pttrn z. t) \ \(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>\_abs\ $ (Syntax.const \<^syntax_const>\_pattern\ $ x_y $ z) $ t end - | case_prod_tr' _ = raise Match; - in [(\<^const_syntax>\case_prod\, K case_prod_tr')] end + | case_prod_tr' _ _ = raise Match; + in [(\<^const_syntax>\case_prod\, case_prod_tr')] end \ diff -r dfd5f665db69 -r 6f8a56a6b391 src/HOL/Set.thy --- 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 @@ \ typed_print_translation \ - [(\<^const_syntax>\Ball\, fn _ => Syntax_Trans.preserve_binder_abs2_tr' \<^syntax_const>\_Ball\), - (\<^const_syntax>\Bex\, fn _ => Syntax_Trans.preserve_binder_abs2_tr' \<^syntax_const>\_Bex\)] + [(\<^const_syntax>\Ball\, Syntax_Trans.preserve_binder_abs2_tr' \<^syntax_const>\_Ball\), + (\<^const_syntax>\Bex\, Syntax_Trans.preserve_binder_abs2_tr' \<^syntax_const>\_Bex\)] \ \ \to avoid eta-contraction of body\ print_translation \ @@ -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>\_Coll\ $ x $ t; in case t of diff -r dfd5f665db69 -r 6f8a56a6b391 src/Pure/Isar/subgoal.ML --- 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; diff -r dfd5f665db69 -r 6f8a56a6b391 src/Pure/Syntax/syntax_phases.ML --- 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 diff -r dfd5f665db69 -r 6f8a56a6b391 src/Pure/Syntax/syntax_trans.ML --- 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; diff -r dfd5f665db69 -r 6f8a56a6b391 src/Pure/primitive_defs.ML --- 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 (\)"; diff -r dfd5f665db69 -r 6f8a56a6b391 src/Pure/type_infer_context.ML --- 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; diff -r dfd5f665db69 -r 6f8a56a6b391 src/Pure/variable.ML --- 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 diff -r dfd5f665db69 -r 6f8a56a6b391 src/Tools/induct.ML --- 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): " ^ diff -r dfd5f665db69 -r 6f8a56a6b391 src/Tools/subtyping.ML --- 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;