diff -r 08d492f6c1b5 -r a14eb229011d src/HOL/Tools/Predicate_Compile/predicate_compile_data.ML --- a/src/HOL/Tools/Predicate_Compile/predicate_compile_data.ML Sat Nov 30 13:31:43 2024 +0100 +++ b/src/HOL/Tools/Predicate_Compile/predicate_compile_data.ML Sat Nov 30 13:27:15 2024 +0100 @@ -127,26 +127,22 @@ val i = length (binder_types (fastype_of f)) - length args in funpow i (fn th => th RS meta_fun_cong) th end; -fun declare_names s xs ctxt = - let - val res = Name.invent_names ctxt s xs - in (res, fold Name.declare (map fst res) ctxt) end - fun split_all_pairs thy th = let val ctxt = Proof_Context.init_global thy (* FIXME proper context!? *) val ((_, [th']), _) = Variable.import true [th] ctxt val t = Thm.prop_of th' val frees = Term.add_frees t [] - val freenames = Term.add_free_names t [] - val nctxt = Name.make_context freenames fun mk_tuple_rewrites (x, T) nctxt = let val Ts = HOLogic.flatten_tupleT T - val (xTs, nctxt') = declare_names x Ts nctxt + val xTs = Name.invent_names nctxt x Ts + val nctxt' = fold (Name.declare o #1) xTs nctxt val paths = HOLogic.flat_tupleT_paths T in ((Free (x, T), HOLogic.mk_ptuple paths T (map Free xTs)), nctxt') end - val (rewr, _) = fold_map mk_tuple_rewrites frees nctxt + val (rewr, _) = + Name.build_context (Term.declare_free_names t) + |> fold_map mk_tuple_rewrites frees val t' = Pattern.rewrite_term thy rewr [] t val th'' = Goal.prove ctxt (Term.add_free_names t' []) [] t'