diff --git a/.gitignore b/.gitignore index b25c15b8..9d4fccfe 100644 --- a/.gitignore +++ b/.gitignore @@ -1 +1,2 @@ *~ +Scratch.thy diff --git a/README.md b/README.md index ffc9464a..8f360a8f 100644 --- a/README.md +++ b/README.md @@ -48,12 +48,12 @@ The formalization is organized into the following sessions: | -------------------------- | -------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- | | Isabelle_Prelim | Administrative session bundling the standard Isabelle libraries that we use. | | Prelim | Miscellaneous extensions to standard libraries, and bindings-specific infrastructure (e.g., countable and uncountable types we use for variables). | -| Binders | Main metatheory including the formalization our Thms 19, called strong_induct in the formalization, and 22 (called BE_iinduct in Generic_Strong_Rule_Induction.thy (Sect. 4, 7.3, 8.2, 8.4 and App. G.2), the proof that our results generalize the Urban/Berghofer/Norrish criterion in Urban_Berghofer_Norrish_Rule_Induction.thy (claimed in the paper and detailed in App. A), and the binding-aware datatype automation in MRBNF_Composition.thy and MRBNF_Recursor.thy and various ML files (App. G). Also contains the formalization of Counterexample 16 (Sect. 8.2) in No_Least_Support_Counterexample.thy. | +| Binders | Main metatheory including the formalization our Thms 19, called strong_induct in the formalization, and 22 (called strong_iinduct in Generic_Strong_Rule_Induction.thy (Sect. 4, 8.3, 9.2, 9.4 and App. G.2), the proof that our results generalize the Urban/Berghofer/Norrish criterion in Urban_Berghofer_Norrish_Rule_Induction.thy (claimed in the paper and detailed in App. A), and the binding-aware datatype automation in MRBNF_Composition.thy and MRBNF_Recursor.thy and various ML files (App. G). Also contains the formalization of Counterexample 16 (Sect. 9.2) in No_Least_Support_Counterexample.thy. | | Untyped_Lambda_Calculus | Formalization of the untyped lambda calculus including beta reduction and parallel beta reduction (Sect. 2). | -| Process_Calculus | Formalization of the pi-calculus transition relation and the associated strong rule induction principle (Sect. 7.1 and App. D.3) -- covering both the early-instantiation and late-instantiation semantics, in theories Pi_Transition_Early.thy and Pi_Transition_Late.thy | -| System_Fsub | Formalization of System F with subtyping, the associated strong rule induction principles, and the POPLmark challenge 1A (Sect. 7.2 and App. F). | -| Infinitary_Lambda_Calculus | Formalization of Mazza's isomorphism between the untyped lambda calculus and the affine uniform infinitary lambda calculus (Sect 8.3 and App. E), with the end results stated in Iso_LC_ILC.thy. | -| Infinitary_FOL | Formalization of the infinitary first-order logic deduction relation and the associated strong rule induction principle (Sect 8.1 and App. D.4). | +| Process_Calculus | Formalization of the pi-calculus transition relation and the associated strong rule induction principle (Sect. 8.1 and App. D.3) -- covering both the early-instantiation and late-instantiation semantics, in theories Pi_Transition_Early.thy and Pi_Transition_Late.thy | +| System_Fsub | Formalization of System F with subtyping, the associated strong rule induction principles, and the POPLmark challenge 1A (Sect. 8.2 and App. F). | +| Infinitary_Lambda_Calculus | Formalization of Mazza's isomorphism between the untyped lambda calculus and the affine uniform infinitary lambda calculus (Sect 9.3 and App. E), with the end results stated in Iso_LC_ILC.thy. | +| Infinitary_FOL | Formalization of the infinitary first-order logic deduction relation and the associated strong rule induction principle (Sect 9.1 and App. D.4). | The session structure resembles the directory structure: theories from session are placed in the directory src/thys/. Exceptions to this rule are the Isabelle_Prelim session which @@ -67,13 +67,13 @@ The formalization uses notations that are close to those from the paper, but mak Another specificity of the formalization is that the datatypes are defined to have more generic/polymorphic types than in the paper, after which they are instantiated to the exact types from the paper. Namely, instead of working with a fixed set of variables of suitable cardinality (which in the finitary case is just the cardinal of natural numbers aleph0), that set is kept as a parameter -- and in Isabelle, taking advantage of polymorphism, this is a type variable 'var of type class that specifies the cardinality constraint. (Our `binder_datatype` command automatically assigns 'var to have the suitable type class.) This allows more flexibility in case we want to nest the given datatype inside another datatype that perhaps requires larger collections of variables. But once the exact datatypes needed for a case study have been decided, one can instantiate 'var with a fixed type, var, of suitable cardinality. And this is what we do in all our example datatypes: First define the polymorphic version, then instantiate it to the monomorphic version (which matches the one described in the paper). We consistently use the suffix `P` for the polymorphic version. For example, we introduce `ltermP` as the type of lambda-terms polymorphic in the type of variables, then we take `lterm` to be the instance `var ltermP` for some fixed countable type of variables `var`. (The paper's implementation section 9 and the appendix implementation section G have some ad hoc choices of names, e.g., `type` versus `typ` and `term` versus `trm`, which we have decided to amend to the notation scheme explained above -- and will of course update the paper accordingly.) -Another place where the formalization uses different notations is that of pi-calculusm (Sect. 7.1). Namely we prefer ASCII notations with self-explanatory names, such as `Sum`, `Inp`, `Out` etc. The same is true for the dirrent versions of beta-reduction, where we use the notations `step`, `pstep` (for the parallel version) etc. instead of arrow notation. Finally, we sometimes introduce small variations to help parsing, e.g., double comma rather than comma for context-append in System F subtyping (Sect. 7.2). +Another place where the formalization uses different notations is that of pi-calculusm (Sect. 8.1). Namely we prefer ASCII notations with self-explanatory names, such as `Sum`, `Inp`, `Out` etc. The same is true for the dirrent versions of beta-reduction, where we use the notations `step`, `pstep` (for the parallel version) etc. instead of arrow notation. Finally, we sometimes introduce small variations to help parsing, e.g., double comma rather than comma for context-append in System F subtyping (Sect. 8.2). ### Formalization of the abstract results -As sketched in the fourth paragraph of Sect. 9 and the first paragraph of App. G.2, the general theorems have been formalized using Isabelle's locales, which are essentially persistent contexts that fix some type variables and term variables on them---and one can prove facts relative to these contexts. Locales corresponding to our three main theorems, Thm. 7, Thm. 19 and Thm. 22, are in the theory thys/Generic_Strong_Rule_Induction.thy. +As sketched in the fourth paragraph of Sect. 10 and the first paragraph of App. G.2, the general theorems have been formalized using Isabelle's locales, which are essentially persistent contexts that fix some type variables and term variables on them---and one can prove facts relative to these contexts. Locales corresponding to our three main theorems, Thm. 7, Thm. 19 and Thm. 22, are in the theory thys/Generic_Strong_Rule_Induction.thy. -The locale for Thm. 22 is called `IInduct`, and the Isabelle theorem corresponding to Thm. 22 is called `strong_iinduct`. It is built incrementally, from a previous `IInduct1` locale, which in turn extends a `CComponents` locale. The proof of the theorem follows the informal proof described in Sect. 4 (for Thm. 7), with the proof-mining and upgrades described in Sects. 7.3, 8.2 and 8.4 factored in. Overall, the cumulated assumptions of locale `IInduct` are those of Thm. 22, so these assumptions are of course no longer repeated when stating the theorem in the locale. But we can see the self-contained theorem with all assumptions if we type the following command outside the scope of the locale, which unfolds all the locale predicates: +The locale for Thm. 22 is called `IInduct`, and the Isabelle theorem corresponding to Thm. 22 is called `strong_iinduct`. It is built incrementally, from a previous `IInduct1` locale, which in turn extends a `CComponents` locale. The proof of the theorem follows the informal proof described in Sect. 4 (for Thm. 7), with the proof-mining and upgrades described in Sects. 8.3, 9.2 and 9.4 factored in. Overall, the cumulated assumptions of locale `IInduct` are those of Thm. 22, so these assumptions are of course no longer repeated when stating the theorem in the locale. But we can see the self-contained theorem with all assumptions if we type the following command outside the scope of the locale, which unfolds all the locale predicates: ``` print_statement IInduct.strong_iinduct[unfolded @@ -108,27 +108,27 @@ The theory also contains less general versions of the first two of the above loc Most of our examples and case studies consist of three distinct types of theories: -(1) Those introducing the relevant binding-aware datatypes, usually via our `binder_datatype` command described in Sect. 9 and App. G.1. and proving and customizing basic properties about them (such as properties of substitution and swapping). In particular, we have: +(1) Those introducing the relevant binding-aware datatypes, usually via our `binder_datatype` command described in Sect. 10 and App. G.1. and proving and customizing basic properties about them (such as properties of substitution and swapping). In particular, we have: - theory thys/Untyped_Lambda_Calculus/LC.thy dedicated to (the definition and customization of) the datatype of lambda-terms described in Sect. 2 and App. D.1; -- theory thys/Pi_Calculus/Pi.thy dedicated to the datatype of pi-calculus processes described in Sect. 7.1 and App. D.3; -- theory thys/POPLmark/SystemFSub_Types dedicated to the datatype of System-F-with-subtyping types described in Sect. 7.2; -- theory thys/Infinitary_FOL/InfFmla.thy dedicated to the datatype of infinitary FOL formulas described in Sect. 8.1 and App. D.4; here we work parametrically on two infinite regular cardinals `k1` and `k2`, which we axiomatize; -- theory thys/Infinitary_Lambda_Calculus/ILC.thy dedicated to the datatype of infinitary lambda-terms described in Sect. 8.3 and App. D.2. +- theory thys/Pi_Calculus/Pi.thy dedicated to the datatype of pi-calculus processes described in Sect. 8.1 and App. D.3; +- theory thys/POPLmark/SystemFSub_Types dedicated to the datatype of System-F-with-subtyping types described in Sect. 8.2; +- theory thys/Infinitary_FOL/InfFmla.thy dedicated to the datatype of infinitary FOL formulas described in Sect. 9.1 and App. D.4; here we work parametrically on two infinite regular cardinals `k1` and `k2`, which we axiomatize; +- theory thys/Infinitary_Lambda_Calculus/ILC.thy dedicated to the datatype of infinitary lambda-terms described in Sect. 9.3 and App. D.2. -An exception to the rule of using `binder_datatype` is the (non-recursive) datatype of commitments for the pi-calculus (described in Sect. 7.1), for which we use some Isabelle/ML tactics to the same effect in thys/Pi_Calculus/Commitments.thy (the reason being that our parser currently does not yet cover the degenerate case of non-recursive binders). +An exception to the rule of using `binder_datatype` is the (non-recursive) datatype of commitments for the pi-calculus (described in Sect. 8.1), for which we use some Isabelle/ML tactics to the same effect in thys/Pi_Calculus/Commitments.thy (the reason being that our parser currently does not yet cover the degenerate case of non-recursive binders). -(2) Those introducing the relevant binding-aware inductive predicates, usually via our `binder_inductive` command described in Sect. 9 and App. G.2) -- the exceptions being the instances of the binder-explicit Thm. 22, where we instantiate the locale manually. In particular, we have: +(2) Those introducing the relevant binding-aware inductive predicates, usually via our `binder_inductive` command described in Sect. 10 and App. G.2) -- the exceptions being the instances of the binder-explicit Thm. 22, where we instantiate the locale manually. In particular, we have: * In thys/Untyped_Lambda_Calculus, the theories LC_Beta.thy and LC_Parallel_Beta.thy, containing the inductive definitions of lambda-calculus beta-reduction and parallel beta-reduction respectively, referred to in Sects. 2 and 5. In particular, Prop. 2 from the paper (in the enhanced version described in Remark 8) is generated and proved via the `binder_inductive` command from LC_Beta.thy; it is called `step.strong_induct`. The corresponding theorem for parallel-beta is called `pstep.strong_induct`, which is generated and proved from the `binder-inductive` command from LC_Parallel_Beta.thy. A variant of parallel-beta decorated with the counting of the number applicative redexes (which is needed in the Mazza case study) is also defined in LG_Beta-depth.thy (and its strong rule induction follows the same course). -* In thys/Pi_Calculus, the theories Pi_Transition_Early.thy and Pi_Transition_Late.thy use the `binder-inductive` command to define and endow with strong rule induction the late and early transition relations discussed in Sect. 7.1; and the theory Pi_cong.thy does the same for both the structural-congruence and the transition relations for the variant of pi-calculus discussed in App. B. +* In thys/Pi_Calculus, the theories Pi_Transition_Early.thy and Pi_Transition_Late.thy use the `binder-inductive` command to define and endow with strong rule induction the late and early transition relations discussed in Sect. 8.1; and the theory Pi_cong.thy does the same for both the structural-congruence and the transition relations for the variant of pi-calculus discussed in App. B. -* In thys/POPLmark, the theory SystemFSub.thy is dedicated to defining (in addition to some auxiliary concepts such as well-formedness of contexts) the typing relation for System-F-with-subtyping discussed in Sect. 7.2. Here, because (as discussed in Sects. 7.2 and 7.3) we want to make use of an inductively proved lemma before we prove Refreshability (a prerequisite for enabling strong rule induction), we make use of a more flexible version of `binder_inductive`: namely we introduce the typing relation as a standard inductive definition (using Isabelle's `inductive` command), then prove the lemma that we need, and at the end we "make" this predicate into a binder-aware inductive predicate (via our command `make_binder_inductive`), generating the strong induction theorem, here named `ty.strong_induct` (since the typing predicate is called `ty`). Note that, in general, a `binder_inductive` command is equivalent to an `inductive` command followed immediately by a `make_binder_inductive` command. We have implemented this finer-granularity `make_binder_inductive` command after the submission, so it is not yet documented in the paper. (In the previous version of the supplementary material we had a different (less convenient) solution, which inlined everything that needed to be proved as goals produced by `binder_inductive`.) +* In thys/POPLmark, the theory SystemFSub.thy is dedicated to defining (in addition to some auxiliary concepts such as well-formedness of contexts) the typing relation for System-F-with-subtyping discussed in Sect. 8.2. Here, because (as discussed in Sects. 8.2 and 8.3) we want to make use of an inductively proved lemma before we prove Refreshability (a prerequisite for enabling strong rule induction), we make use of a more flexible version of `binder_inductive`: namely we introduce the typing relation as a standard inductive definition (using Isabelle's `inductive` command), then prove the lemma that we need, and at the end we "make" this predicate into a binder-aware inductive predicate (via our command `make_binder_inductive`), generating the strong induction theorem, here named `ty.strong_induct` (since the typing predicate is called `ty`). Note that, in general, a `binder_inductive` command is equivalent to an `inductive` command followed immediately by a `make_binder_inductive` command. We have implemented this finer-granularity `make_binder_inductive` command after the submission, so it is not yet documented in the paper. (In the previous version of the supplementary material we had a different (less convenient) solution, which inlined everything that needed to be proved as goals produced by `binder_inductive`.) * In thys/Infinitary_FOL, the theory InfFOL.thy introduces IFOL deduction again via `binder_inductive'. -* In thys/Infinitary_Lambda_Calculus, we have several instantiations of the general strong induction theorem, Thm. 22. However, this is not done via the `binder_inductive` command, but by manually instantiating the locale coresponding to Thm. 22, namely `IInduct`. This is done for several inductive predicates needed by the Mazza case study: in ILC_Renaming_Equivalence.thy for the renaming equivalence relation from Sect. 8.3, in ILC_UBeta.thy for the uniform infinitary beta-reduction from App. E.3, and in ILC_good.thy for the `good` (auxiliary) predicate from App. E.6. By contrast, the `affine` predicate in from App. E.3, located in ILC_affine.thy, and the plain infinitary beta-reduction from App. E.1, located in ILC_Beta.thy, only require Thm. 19 so they are handled using `binder_inductive`. +* In thys/Infinitary_Lambda_Calculus, we have several instantiations of the general strong induction theorem, Thm. 22. However, this is not done via the `binder_inductive` command, but by manually instantiating the locale coresponding to Thm. 22, namely `IInduct`. This is done for several inductive predicates needed by the Mazza case study: in ILC_Renaming_Equivalence.thy for the renaming equivalence relation from Sect. 9.3, in ILC_UBeta.thy for the uniform infinitary beta-reduction from App. E.3, and in ILC_good.thy for the `good` (auxiliary) predicate from App. E.6. By contrast, the `affine` predicate in from App. E.3, located in ILC_affine.thy, and the plain infinitary beta-reduction from App. E.1, located in ILC_Beta.thy, only require Thm. 19 so they are handled using `binder_inductive`. (3) Proving facts specific to the case studies, namely: @@ -138,7 +138,7 @@ An exception to the rule of using `binder_datatype` is the (non-recursive) datat ### Tactics and automation using Isabelle/ML -As discussed in Sect. 9 and App. G, we have automated the production of binding-aware datatypes and inductive predicates (subject to strong rule induction) using Isabelle/ML, via the commands `binder_datatype`, `binder_inductive` (and its variant `make_binder_inductive`) and proof method `binder_induction`. +As discussed in Sect. 10 and App. G, we have automated the production of binding-aware datatypes and inductive predicates (subject to strong rule induction) using Isabelle/ML, via the commands `binder_datatype`, `binder_inductive` (and its variant `make_binder_inductive`) and proof method `binder_induction`. - The command `binder_datatype` is implemented in `Tools/parser.ML`. However most of the ML code in this directory is used to construct a binder datatype. It also reuses the normal datatype construction code from HOL. - The command `binder_inductive` and `make_binder_inductive` are implemented in `Tools/binder_inductive.ML` and `Tools/binder_inductive_combined.ML`. The `binder_inductive` command just calls the normal Isabelle `inductive` command and immediately follows with a call to `make_binder_inductive`. @@ -161,33 +161,33 @@ Prop 2 --> theorem `step.strong_induct` (generated and proved by `binder_inducti Thms 4 and 5 --> just recallections of the standard result (available in the Isabelle library) -Thm 7 (already the strengthened version discussed in Sect. 7.3) --> theorem `strong_induct_nom` (in locale `Induct_nom`) from thys/Generic_Strong_Rule_Induction.thy. +Thm 7 (already the strengthened version discussed in Sect. 8.3) --> theorem `strong_induct_nom` (in locale `Induct_nom`) from thys/Generic_Strong_Rule_Induction.thy. -##### Section 7.1 +##### Section 8.1 Prop 12 --> theorems called `trans.strong_induct` (generated and proved by `binder_inductive`) from Pi_Transition_Early.thy and Pi_Transition_Late.thy. (As explained in the paper, Prop 12 actually shows a hybrid containing a selection of the more interesting rules for the two types of transitions.) -##### Section 7.2 +##### Section 8.2 Prop 13 --> theorem `ty.strong_induct` (generated and proved by `binder_inductive`) from thys/POPLmark/SystemFSub.thy -##### Section 8.1 +##### Section 9.1 Prop 15 --> theorem `deduct.strong_induct` (generated and proved by `binder_inductive`) from thys/Infinitary_FOL/InfFOL.thy -##### Section 8.2 +##### Section 9.2 Counterexample 16 --> theorem `counterexample` from No_Least_Support_Counterexample.thy Thm 19 --> theorem `strong_induct` (in locale `Induct`) from thys/Generic_Strong_Rule_Induction.thy. -##### Section 8.3 +##### Section 9.3 Prop 20 --> theorem `affine.strong_induct` (generated and proved by `binder_inductive`) from thys/Infinary_Lambda_Calculus/ILC_affine.thy Prop 21 --> theorem `strong_induct_reneqv` from ILC_Renaming_Equivalence.thy -##### Section 8.4 +##### Section 9.4 Thm 22 --> theorem `strong_iinduct` (in locale `IInduct`) from thys/Generic_Strong_Rule_Induction.thy. diff --git a/Tools/binder_inductive.ML b/Tools/binder_inductive.ML index 114900fc..268f5084 100644 --- a/Tools/binder_inductive.ML +++ b/Tools/binder_inductive.ML @@ -1,7 +1,11 @@ signature BINDER_INDUCTIVE = sig - val binder_inductive_cmd: (string * (string * string list) list option) * (string list option * string list option) + datatype options = No_Equiv | No_Refresh | Verbose + + val binder_inductive_cmd: ((options list * string) * (string * string list) list option) * (string list option * string list option) -> local_theory -> Proof.state; + + val config_parser: options list parser; end structure Binder_Inductive : BINDER_INDUCTIVE = @@ -22,7 +26,9 @@ fun collapse (Inl x) = x fun mk_insert x S = Const (@{const_name Set.insert}, fastype_of x --> fastype_of S --> fastype_of S) $ x $ S; -fun binder_inductive_cmd ((pred_name, binds_opt), perms_supps) no_defs_lthy = +datatype options = No_Equiv | No_Refresh | Verbose + +fun binder_inductive_cmd (((options, pred_name), binds_opt), perms_supps) no_defs_lthy = let val binds = the_default [] binds_opt; @@ -74,6 +80,10 @@ fun binder_inductive_cmd ((pred_name, binds_opt), perms_supps) no_defs_lthy = val param_Ts = map (Term.typ_subst_TVars subst) param_Ts; + val param_sugars = map (fn T => Option.mapPartial (fn s => + MRBNF_Sugar.binder_sugar_of no_defs_lthy s + ) (try (fn () => fst (dest_Type T)) ())) param_Ts; + fun collect_binders (Free _) = [] | collect_binders (Var _) = [] | collect_binders (Bound _) = [] @@ -373,17 +383,21 @@ fun binder_inductive_cmd ((pred_name, binds_opt), perms_supps) no_defs_lthy = val perms_specified = map (fn Inl _ => false | _ => true) raw_perms; val supps_specified = map (fn Inl _ => false | _ => true) raw_supps; val one_specified = map2 (fn a => fn b => a orelse b) perms_specified supps_specified; + fun keep_perm xs = cond_keep xs perms_specified; fun keep_supp xs = cond_keep xs supps_specified; fun keep_both xs = cond_keep xs one_specified; fun keep_binders xs = cond_keep xs binders_specified; + fun option x t f = if member (op=) options x then t else f; + val defs = map snd (perms @ supps); + val verbose = member (op=) options Verbose; val goals = map (single o rpair []) ( keep_perm perm_id0_goals @ keep_perm perm_comp_goals @ keep_both supp_seminat_goals @ keep_both perm_support_goals @ keep_supp supp_small_goals @ flat (keep_binders B_small_goals) - @ [G_equiv_goal, G_refresh_goal] + @ option No_Equiv [G_equiv_goal] [] @ option No_Refresh [G_refresh_goal] [] ); fun after_qed thmss lthy = let @@ -445,15 +459,14 @@ fun binder_inductive_cmd ((pred_name, binds_opt), perms_supps) no_defs_lthy = val m2 = length (filter not one_specified); val m3 = length (filter not supps_specified); val m4 = length (filter not binders_specified); - val (((((((perm_id0s, perm_comps), supp_seminats), perm_supports), supp_smalls), B_smalls), G_equiv), G_refresh) = map hd thmss + val (((((((perm_id0s, perm_comps), supp_seminats), perm_supports), supp_smalls), B_smalls), G_equivs), G_refreshs) = map hd thmss |> chop (n - m) ||>> chop (n - m) ||>> chop (n - m2) ||>> chop (n - m2) ||>> chop (num_vars * (n - m3)) ||>> chop (length bind_ts - m4) - ||>> apfst hd o chop 1 - ||> hd; + ||>> chop (option No_Equiv 1 0); fun map_id0_of_mr_bnf (Inl mrbnf) = [MRBNF_Def.map_id0_of_mrbnf mrbnf] | map_id0_of_mr_bnf (Inr (Inl bnf)) = [BNF_Def.map_id0_of_bnf bnf] @@ -601,6 +614,138 @@ fun binder_inductive_cmd ((pred_name, binds_opt), perms_supps) no_defs_lthy = val perm_ids = map (fn thm => thm RS fun_cong RS @{thm trans[OF _ id_apply]}) perm_id0s; + val G_equiv = if member (op=) options No_Equiv then hd G_equivs else + Goal.prove_sorry lthy [] [] G_equiv_goal (fn {context=ctxt, ...} => EVERY1 [ + K (Local_Defs.unfold0_tac ctxt [snd G]), + REPEAT_DETERM o EVERY' [ + TRY o etac ctxt @{thm disj_forward}, + REPEAT_DETERM o eresolve_tac ctxt [exE, conjE], + REPEAT_DETERM_N (length param_Ts + 1) o etac ctxt @{thm subst[OF sym]}, + Subgoal.FOCUS_PARAMS (fn {context=ctxt, params, ...} => + let + val (fs, args) = map (Thm.term_of o snd) params + |> drop 2 + |> chop 1 + ||> drop (length param_Ts); + val (mr_bnfs, ts) = apfst (map snd o flat) (split_list (map (fn x => case find_index (curry (op=) (fastype_of x)) param_Ts of + ~1 => (case find_index (curry (op=) (fastype_of x)) var_Ts of + ~1 => apsnd (fn t => t $ x) (build_permute_for fs var_Ts (fastype_of x)) + | n => ([], nth fs n $ x)) + | n => ([], Term.list_comb (fst (nth perms n), fs) $ x) + ) args)); + val equiv_commute = Named_Theorems.get ctxt "MRBNF_Recursor.equiv_commute"; + val equiv = Named_Theorems.get ctxt "MRBNF_Recursor.equiv" @ equiv_commute; + val equiv_simps = Named_Theorems.get ctxt "MRBNF_Recursor.equiv_simps" + val monos = Inductive.get_monos ctxt + val set_maps = maps set_map_of_mr_bnf mr_bnfs; + in EVERY1 [ + EVERY' (map (fn t => rtac ctxt ( + infer_instantiate' ctxt [NONE, SOME (Thm.cterm_of ctxt t)] exI + )) ts), + SELECT_GOAL (Local_Defs.unfold0_tac ctxt (map snd perms)), + rtac ctxt conjI, + SELECT_GOAL (Local_Defs.unfold0_tac ctxt (@{thms image_Un} @ equiv_simps)), + REPEAT_DETERM o rtac ctxt @{thm arg_cong2[of _ _ _ _ "(\)"]}, + REPEAT_DETERM1 o EVERY' [ + resolve_tac ctxt @{thms image_single[symmetric] image_empty refl} ORELSE' EVERY' [ + resolve_tac ctxt (map (fn thm => thm RS sym) (set_maps @ equiv_simps) @ equiv_simps), + REPEAT_DETERM o assume_tac ctxt + ] + ], + K (Local_Defs.unfold0_tac ctxt @{thms id_apply}), + K (Local_Defs.unfold0_tac ctxt @{thms id_def[symmetric]}), + REPEAT_DETERM o EVERY' [ + TRY o rtac ctxt conjI, + SELECT_GOAL (EVERY1 [ + REPEAT_DETERM1 o FIRST' [ + assume_tac ctxt, + eresolve_tac ctxt [conjE], + resolve_tac ctxt @{thms conjI refl TrueI bij_imp_bij_inv supp_inv_bound}, + rtac ctxt impI THEN' eresolve_tac ctxt @{thms injD[OF bij_is_inj, rotated -1]}, + EVERY' [ + SELECT_GOAL (Local_Defs.unfold0_tac ctxt (map_filter (try (fn thm => thm RS sym)) equiv_commute)), + REPEAT_DETERM1 o EVERY' [ + EqSubst.eqsubst_tac ctxt [0] (map (Local_Defs.unfold0 ctxt (map snd perms)) perm_comps), + REPEAT_DETERM1 o (assume_tac ctxt ORELSE' resolve_tac ctxt @{thms supp_inv_bound bij_imp_bij_inv}) + ], + K (Local_Defs.unfold0_tac ctxt @{thms inv_o_simp1 inv_o_simp2 inv_simp1 inv_simp2}), + K (Local_Defs.unfold0_tac ctxt (map (Local_Defs.unfold0 ctxt (map snd perms)) perm_ids)), + assume_tac ctxt + ], + eresolve_tac ctxt (map_filter (try (fn thm => Drule.rotate_prems ~1 thm)) equiv), + CHANGED o SELECT_GOAL (Local_Defs.unfold0_tac ctxt (equiv @ equiv_simps @ flat (map_filter (Option.map #permute_simps) param_sugars))), + eresolve_tac ctxt (map (fn thm => Drule.rotate_prems ~1 (thm RS mp)) monos), + resolve_tac ctxt monos, + CHANGED o SELECT_GOAL (Local_Defs.unfold0_tac ctxt (flat (map_filter (Option.map (map (fn thm => thm RS sym) o #permute_simps)) param_sugars))) + ] + ]) + ] + ] end + ) ctxt + ] + ]); + val _ = (verbose ? @{print}) G_equiv + + val G_refresh = if member (op=) options No_Refresh then hd (G_refreshs) else + let + val var_rules = map (fn thm => + let val t = Logic.unvarify_global (Thm.prop_of thm) + in (map Free (rev (Term.add_frees t [])), t) end + ) intrs; + + fun collect_permutes _ (Free _) = [] + | collect_permutes _ (Var _) = [] + | collect_permutes _ (Bound _) = [] + | collect_permutes _ (Const _) = [] + | collect_permutes vars (Abs (_, _, t)) = collect_permutes vars t + | collect_permutes vars (t as (t1 $ t2)) = case try (dest_Type o Term.body_type o fastype_of) t of + NONE => collect_permutes vars t1 @ collect_permutes vars t2 + | SOME (s, _) => (case MRBNF_Sugar.binder_sugar_of no_defs_lthy s of + NONE => collect_permutes vars t1 @ collect_permutes vars t2 + | SOME sugar => + let val (ctor, args) = Term.strip_comb t + in case (map_filter I (map_index (fn (i, (t, _)) => + if (op=) (apply2 (fst o dest_Const) (t, ctor)) then + SOME i else NONE + ) (#ctors sugar))) of + [] => collect_permutes vars t1 @ collect_permutes vars t2 + | ctor_idx::_ => (case nth (hd (#bsetss sugar)) ctor_idx of + NONE => maps (collect_permutes vars) args + | SOME _ => + let + val arg_Ts = Term.binder_types (fastype_of ctor); + val permute_bounds = nth (#permute_bounds sugar) ctor_idx; + val var_args = map (fn t => if member (op=) vars t then SOME t else NONE) args; + val result = map_filter I (map2 (fn NONE => K NONE + | SOME perm => Option.map (fn x => (x, perm)) + ) permute_bounds var_args); + + val tyenv = @{fold 2} (fn NONE => K I | SOME perm => fn T => + Sign.typ_match (Proof_Context.theory_of no_defs_lthy) (body_type (fastype_of perm), T) + ) permute_bounds arg_Ts Vartab.empty; + + in map (apsnd (Envir.subst_term (tyenv, Vartab.empty))) result + @ maps (collect_permutes vars) args + end + ) + end + ); + fun isNONE NONE = true + | isNONE _ = false + val permute_bounds = map (distinct (op=) o uncurry collect_permutes) var_rules; + val matrix = map2 (fn (vars, _) => fn perms => + let val inner = map (AList.lookup (op=) perms) vars; + in if forall isNONE inner then NONE else SOME inner end + ) var_rules permute_bounds; + val _ = (verbose ? @{print}) (map (Option.map (map (Option.map (Thm.cterm_of lthy)))) matrix) + in Goal.prove_sorry lthy [] [] G_refresh_goal (fn {context=ctxt, ...} => EVERY1 [ + K (Local_Defs.unfold0_tac ctxt (snd G :: map snd perms)), + Subgoal.FOCUS (fn {context=ctxt, prems, ...} => + refreshability_tac_internal verbose (map fst supps) matrix (nth prems 2) (nth prems 1) supp_smalls (map snd supps) ctxt + ) ctxt + ]) end; + val _ = (verbose ? @{print}) G_refresh + fun mk_induct mono = Drule.rotate_prems ~1 ( apply_n @{thm le_funD} n (@{thm lfp_induct} OF [mono]) RS @{thm le_boolD} @@ -1009,7 +1154,15 @@ val parse_perm_supps = >> (fn ps => fold extract_perm_supp ps (NONE, NONE)) || Scan.succeed (NONE, NONE); -val binder_inductive_parser = Parse.name -- Scan.option ( +val options_parser = Parse.group (fn () => "option") + ((Parse.reserved "no_auto_equiv" >> K No_Equiv) + || (Parse.reserved "no_auto_refresh" >> K No_Refresh) + || (Parse.reserved "verbose" >> K Verbose)) + +val config_parser = Scan.optional (@{keyword "("} |-- + Parse.!!! (Parse.list1 options_parser) --| @{keyword ")"}) [] + +val binder_inductive_parser = config_parser -- Parse.name -- Scan.option ( @{keyword where} |-- Parse.enum1 "|" (Parse.name --| @{keyword binds} -- Parse.and_list Parse.term) ) -- parse_perm_supps @@ -1017,4 +1170,4 @@ val _ = Outer_Syntax.local_theory_to_proof \<^command_keyword>\make_binder_inductive\ "derive strengthened induction theorems for inductive predicates" (binder_inductive_parser >> binder_inductive_cmd); -end \ No newline at end of file +end diff --git a/Tools/binder_inductive_combined.ML b/Tools/binder_inductive_combined.ML index 53d6fa30..ace36c45 100644 --- a/Tools/binder_inductive_combined.ML +++ b/Tools/binder_inductive_combined.ML @@ -3,18 +3,19 @@ struct fun ind_decl co args = let - val names = map (fn (x, _, _) => x) (fst (Parse.vars args)); - val (inductive, rest) = Inductive.gen_ind_decl Inductive.add_ind_def co args; + val (options, rest) = Binder_Inductive.config_parser args; + val names = map (fn (x, _, _) => x) (fst (Parse.vars rest)); + val (inductive, rest) = Inductive.gen_ind_decl Inductive.add_ind_def co rest; in (fn lthy => let val lthy = snd (Local_Theory.begin_nested lthy); val lthy = inductive lthy; val (lthy, old_lthy) = `Local_Theory.end_nested lthy; - val state = Binder_Inductive.binder_inductive_cmd ((Binding.name_of (hd names), NONE), (NONE, NONE)) lthy + val state = Binder_Inductive.binder_inductive_cmd (((options, Binding.name_of (hd names)), NONE), (NONE, NONE)) lthy in state end, rest) end; val _ = Outer_Syntax.local_theory_to_proof \<^command_keyword>\binder_inductive\ "derive strengthened induction theorems for inductive predicates" (ind_decl false); -end \ No newline at end of file +end diff --git a/Tools/mrbnf_fp.ML b/Tools/mrbnf_fp.ML index b9f95e31..a2f55f70 100644 --- a/Tools/mrbnf_fp.ML +++ b/Tools/mrbnf_fp.ML @@ -2363,6 +2363,35 @@ fun construct_binder_fp fp mrbnf_ks binding_relation lthy = val cctor_eq_intro_rrenames = map (fn thm => (thm RS iffD2) |> funpow fbound (fn thm => thm OF [exI]) OF [mk_conjIN (3*fbound + 1)]) TT_injects0; + fun mk_noclash_rename renames FVars_renames = @{map 4} (fn mrbnf => fn map_t => fn noclash => fn x => + let + val goal = mk_Trueprop_eq ( + fst noclash $ (comb_mrbnf_term ffs_ids (map (fn t => Term.list_comb (t, ffs)) renames) map_t $ x), + fst noclash $ x + ); + in Goal.prove_sorry lthy (map (fst o dest_Free) (ffs @ [x])) prem_terms_ffs goal (fn {context=ctxt, prems} => EVERY1 [ + K (Local_Defs.unfold0_tac ctxt [snd noclash]), + REPEAT_DETERM o EVERY' [ + EqSubst.eqsubst_tac ctxt [0] (MRBNF_Def.set_map_of_mrbnf mrbnf), + REPEAT_DETERM o resolve_tac ctxt (@{thms supp_id_bound bij_id} @ prems) + ], + K (Local_Defs.unfold0_tac ctxt @{thms image_comp[unfolded comp_def]}), + REPEAT_DETERM o EVERY' [ + EqSubst.eqsubst_tac ctxt [0] FVars_renames, + REPEAT_DETERM o resolve_tac ctxt prems + ], + K (Local_Defs.unfold0_tac ctxt @{thms image_Un[symmetric] image_UN[symmetric]}), + REPEAT_DETERM o EVERY' [ + EqSubst.eqsubst_tac ctxt [0] @{thms image_Int[OF bij_is_inj, symmetric]}, + resolve_tac ctxt prems + ], + K (Local_Defs.unfold0_tac ctxt @{thms image_is_empty}), + rtac ctxt refl + ]) end + ) mrbnfs; + val noclash_renames = mk_noclash_rename renamesAs (flat FVars_renamess) mrbnf_maps_AsAs noclashs xs; + val nnoclash_rrenames = mk_noclash_rename rrenamesAs (flat FFVars_rrenamess) mrbnf_maps_BsBs nnoclashs vs; + (* TODO: use giant map instead of x times (nth ... i) *) val (raw_ress, quot_ress) = split_list (map (fn i => let @@ -2375,6 +2404,7 @@ fun construct_binder_fp fp mrbnf_ks binding_relation lthy = noclash = nth noclashs i, inject = nth raw_injects i, + noclash_rename = nth noclash_renames i, rename_id0 = nth rename_id0s i, rename_id = nth rename_ids i, rename_comp0 = nth rename_comp0s i, @@ -2417,6 +2447,7 @@ fun construct_binder_fp fp mrbnf_ks binding_relation lthy = noclash = nth nnoclashs i, inject = nth TT_injects0 i, + noclash_rename = nth nnoclash_rrenames i, rename_id0 = nth rrename_id0s i, rename_id = nth rrename_ids i, rename_comp0 = nth rrename_comp0s i, @@ -2491,6 +2522,8 @@ fun construct_binder_fp fp mrbnf_ks binding_relation lthy = ("alpha_avoids", alpha_avoids), ("equivp_alphas", equivp_alphas), ("nnoclash_noclashs", nnoclash_noclashs), + ("nnoclash_rrenames", nnoclash_rrenames), + ("noclash_renames", noclash_renames), ("TT_Quotients", TT_Quotients), ("TT_alpha_quotient_syms", alpha_quotient_syms), ("TT_Quotient_total_abs_eq_iffs", Quotient_total_abs_eq_iffs), diff --git a/Tools/mrbnf_fp_def_sugar.ML b/Tools/mrbnf_fp_def_sugar.ML index 20534c27..e8ae2268 100644 --- a/Tools/mrbnf_fp_def_sugar.ML +++ b/Tools/mrbnf_fp_def_sugar.ML @@ -9,6 +9,7 @@ sig inner: 'a, inject: thm, + noclash_rename: thm, rename_id0: thm, rename_id: thm, rename_comp0: thm, @@ -100,6 +101,7 @@ type 'a fp_result_T = { inner: 'a, inject: thm, + noclash_rename: thm, rename_id0: thm, rename_id: thm, rename_comp0: thm, @@ -115,7 +117,7 @@ type 'a fp_result_T = { fun morph_fp_result_T morph phi { T, ctor, rename, FVars, inner, inject, rename_id0, rename_id, rename_comp0, rename_comp, rename_bij, rename_inv_simp, FVars_ctors, FVars_renames, card_of_FVars_bounds, - card_of_FVars_bound_UNIVs, FVars_intross, noclash } = { + card_of_FVars_bound_UNIVs, FVars_intross, noclash, noclash_rename } = { T = Morphism.typ phi T, ctor = Morphism.term phi ctor, rename = Morphism.term phi rename, @@ -123,6 +125,7 @@ fun morph_fp_result_T morph phi { T, ctor, rename, FVars, inner, inject, rename_ noclash = BNF_Util.map_prod (Morphism.term phi) (Morphism.thm phi) noclash, inner = morph phi inner, inject = Morphism.thm phi inject, + noclash_rename = Morphism.thm phi noclash_rename, rename_id0 = Morphism.thm phi rename_id0, rename_id = Morphism.thm phi rename_id, rename_comp0 = Morphism.thm phi rename_comp0, diff --git a/Tools/mrbnf_sugar.ML b/Tools/mrbnf_sugar.ML index 5595acde..8bd3a668 100644 --- a/Tools/mrbnf_sugar.ML +++ b/Tools/mrbnf_sugar.ML @@ -14,8 +14,10 @@ type spec = { type binder_sugar = { map_simps: thm list, set_simpss: thm list list, + permute_simps: thm list, subst_simps: thm list option, bsetss: term option list list, + permute_bounds: term option list list, bset_bounds: thm list, mrbnf: MRBNF_Def.mrbnf, strong_induct: thm, @@ -55,8 +57,10 @@ type spec = { type binder_sugar = { map_simps: thm list, set_simpss: thm list list, + permute_simps: thm list, subst_simps: thm list option, bsetss: term option list list, + permute_bounds: term option list list, bset_bounds: thm list, mrbnf: MRBNF_Def.mrbnf, strong_induct: thm, @@ -64,12 +68,14 @@ type binder_sugar = { ctors: (term * thm) list }; -fun morph_binder_sugar phi { map_simps, set_simpss, subst_simps, mrbnf, - strong_induct, distinct, ctors, bsetss, bset_bounds } = { +fun morph_binder_sugar phi { map_simps, permute_simps, set_simpss, subst_simps, mrbnf, + strong_induct, distinct, ctors, bsetss, bset_bounds, permute_bounds } = { map_simps = map (Morphism.thm phi) map_simps, + permute_simps = map (Morphism.thm phi) permute_simps, set_simpss = map (map (Morphism.thm phi)) set_simpss, subst_simps = Option.map (map (Morphism.thm phi)) subst_simps, bsetss = map (map (Option.map (Morphism.term phi))) bsetss, + permute_bounds = map (map (Option.map (Morphism.term phi))) permute_bounds, bset_bounds = map (Morphism.thm phi) bset_bounds, mrbnf = MRBNF_Def.morph_mrbnf phi mrbnf, strong_induct = Morphism.thm phi strong_induct, @@ -331,8 +337,7 @@ fun create_binder_datatype (spec : spec) lthy = val bounds = map_filter (fn (x, MRBNF_Def.Bound_Var) => SOME (TFree x) | _ => NONE) (#vars spec); val frees = map_filter (fn (x, MRBNF_Def.Free_Var) => SOME (TFree x) | _ => NONE) (#vars spec); - (* TODO: Use mrbnf sets here (only relevant for passive variables) *) - val (bset_optss, set_simpss) = split_list (map (fn FVars => + val param_vars = map (fn FVars => let fun get_var vars = hd (filter (fn T => Term.typ_subst_atomic replace T = HOLogic.dest_setT (range_type (fastype_of FVars)) @@ -342,7 +347,12 @@ fun create_binder_datatype (spec : spec) lthy = val rec_bounds = map (nth rec_vars) (the_default [] ( Option.mapPartial (try (nth (#binding_rel spec))) (get_index bound bounds) )); - in split_list (map2 (fn (ctor, _) => fn (_, tys) => + in (free, bound, rec_bounds) end + ) (#FVars quotient); + + (* TODO: Use mrbnf sets here (only relevant for passive variables) *) + val (bset_optss, set_simpss) = split_list (map2 (fn FVars => fn (free, bound, rec_bounds) => + split_list (map2 (fn (ctor, _) => fn (_, tys) => let val (xs, _) = lthy |> mk_Frees "x" tys; @@ -403,9 +413,10 @@ fun create_binder_datatype (spec : spec) lthy = ] ])) end ) ctors (#ctors spec)) - end) (#FVars quotient)); + ) (#FVars quotient) param_vars); val ctors_tys = ctors ~~ map snd (#ctors spec); + val distinct = flat (flat (map_index (fn (i, ((ctor, ctor_def), tys1)) => map_index (fn (j, ((ctor2, ctor2_def), tys2)) => let val ((xs, ys), _) = names_lthy @@ -424,7 +435,7 @@ fun create_binder_datatype (spec : spec) lthy = ])] end ) ctors_tys) ctors_tys)); - (* TODO: map_bij (rename simps); injection *) + (* TODO: injection *) (* Term for variable substitution *) val x = length replace - #rec_vars spec; @@ -505,10 +516,13 @@ fun create_binder_datatype (spec : spec) lthy = UN_single }; val nvars = length vars; - fun mk_map_simps lthy fs mk_supp_bound_opt mk_imsupp mapx tac = + fun mk_map_simps lthy do_noclash fs mk_supp_bound_opt mk_imsupp_opt mk_extra_prems extra_apply_args mapx tac = let val mapx = Term.list_comb (mapx, fs); - val prems = map_filter (Option.map HOLogic.mk_Trueprop o mk_supp_bound_opt) fs; + val (prem_fs, prems) = split_list (map_filter (fn f => case mk_supp_bound_opt f of + NONE => NONE + | SOME t => SOME (f, HOLogic.mk_Trueprop t) + ) fs); fun mk_map (T as Type (n, Ts)) = (case MRBNF_Def.mrbnf_of lthy n of SOME mrbnf => @@ -524,7 +538,7 @@ fun create_binder_datatype (spec : spec) lthy = else Term.list_comb (inner_map, gs) end | NONE => HOLogic.id_const T) | mk_map (T as TFree _) = - (if member (op=) frees T then + (if member (op=) (frees @ extra_apply_args) T then case List.find (fn Free (_, T') => domain_type T' = Term.typ_subst_atomic replace T) fs of SOME t => t | NONE => HOLogic.id_const T @@ -576,16 +590,19 @@ fun create_binder_datatype (spec : spec) lthy = | NONE => replicate nvars NONE in map2 (fn b => fn FVars => map_filter I (map2 (mk_set (b::recs) FVars) tys xs)) vars FVars end; val bound_sets = mk_sets bounds [] NONE; - fun get_fs T = filter (fn t' => HOLogic.dest_setT (fastype_of (mk_imsupp t' T)) = T) fs; + fun get_fs T = filter (fn t' => case mk_imsupp_opt t' T of + NONE => false + | SOME t => HOLogic.dest_setT (fastype_of t) = T + ) fs; val imsupp_prems = maps (map_filter (fn t => case Term.subst_atomic_types replace t of (Const (@{const_name Set.insert}, _) $ (t as Free (_, T)) $ _) => (case get_fs T of [] => NONE - | xs => SOME (HOLogic.mk_Trueprop (HOLogic.mk_not (HOLogic.mk_mem (t, foldl1 mk_Un (map (fn f => mk_imsupp f T) xs)))))) + | xs => SOME (HOLogic.mk_Trueprop (HOLogic.mk_not (HOLogic.mk_mem (t, foldl1 mk_Un (map (fn f => the (mk_imsupp_opt f T)) xs)))))) | t => let val T = HOLogic.dest_setT (fastype_of t); in case get_fs T of [] => NONE - | xs => SOME (HOLogic.mk_Trueprop (mk_int_empty (t, foldl1 mk_Un (map (fn f => mk_imsupp f T) xs)))) + | xs => SOME (HOLogic.mk_Trueprop (mk_int_empty (t, foldl1 mk_Un (map (fn f => the (mk_imsupp_opt f T)) xs)))) end )) bound_sets; @@ -594,14 +611,16 @@ fun create_binder_datatype (spec : spec) lthy = val free_rec_vars = subtract (op=) (map (nth rec_vars) (flat (#binding_rel spec))) rec_vars; val free_sets = collect_sets (mk_sets frees free_rec_vars (SOME (#FVars quotient))); - val noclash_prems = map_filter (Option.map HOLogic.mk_Trueprop) (map2 (fn a => fn b => case (a, b) of - (SOME (Const (@{const_name Set.insert}, _) $ x $ _), SOME (Const (@{const_name Set.insert}, _) $ y $ _)) => - SOME (HOLogic.mk_not (HOLogic.mk_eq (x, y))) - | (SOME (Const (@{const_name Set.insert}, _) $ x $ _), SOME ys) => SOME (HOLogic.mk_not (HOLogic.mk_mem (x, ys))) - | (SOME xs, SOME (Const (@{const_name Set.insert}, _) $ y $ _)) => SOME (HOLogic.mk_not (HOLogic.mk_mem (y, xs))) - | (SOME free, SOME bound) => SOME (mk_int_empty (free, bound)) - | _ => NONE - ) bound_sets' free_sets); + val noclash_prems = if do_noclash then + map_filter (Option.map HOLogic.mk_Trueprop) (map2 (fn a => fn b => case (a, b) of + (SOME (Const (@{const_name Set.insert}, _) $ x $ _), SOME (Const (@{const_name Set.insert}, _) $ y $ _)) => + SOME (HOLogic.mk_not (HOLogic.mk_eq (x, y))) + | (SOME (Const (@{const_name Set.insert}, _) $ x $ _), SOME ys) => SOME (HOLogic.mk_not (HOLogic.mk_mem (x, ys))) + | (SOME xs, SOME (Const (@{const_name Set.insert}, _) $ y $ _)) => SOME (HOLogic.mk_not (HOLogic.mk_mem (y, xs))) + | (SOME free, SOME bound) => SOME (mk_int_empty (free, bound)) + | _ => NONE + ) bound_sets' free_sets) + else []; val rhs = if length ts = 1 andalso member (op=) frees (hd tys) andalso fastype_of (hd ts) = range_type (fastype_of quotient_ctor) @@ -609,7 +628,7 @@ fun create_binder_datatype (spec : spec) lthy = val goal = mk_Trueprop_eq ( mapx $ Term.list_comb (ctor, xs), rhs ); - in Goal.prove_sorry lthy (names (fs @ xs)) (prems @ imsupp_prems @ noclash_prems) goal (fn {context=ctxt, prems} => + in Goal.prove_sorry lthy (names (fs @ xs)) (flat (map2 (fn p => fn f => mk_extra_prems f @ [p]) prems prem_fs) @ imsupp_prems @ noclash_prems) goal (fn {context=ctxt, prems} => Local_Defs.unfold0_tac ctxt [ctor_def] THEN tac ctxt prems ) end ) ctors (#ctors spec) end; @@ -640,7 +659,48 @@ fun create_binder_datatype (spec : spec) lthy = K (Local_Defs.unfold0_tac ctxt @{thms id_def}), rtac ctxt refl ]; - in mk_map_simps lthy fs (SOME o MRBNF_Recursor.mk_supp_bound) (fn t => fn _ => mk_imsupp t) mapx tac end; + in mk_map_simps lthy true fs (SOME o MRBNF_Recursor.mk_supp_bound) (fn t => fn _ => SOME (mk_imsupp t)) (K []) [] mapx tac end; + + val (fs, _) = lthy + |> mk_Frees "f" (map (fn a => a --> a) vars); + val permute_simps = + let + val Ts' = snd (dest_Type qT); + val mapx = Term.subst_atomic_types (Ts' ~~ vars) (#rename quotient); + fun tac ctxt prems = EVERY1 [ + rtac ctxt (trans OF [#rename_ctor (#inner quotient)]), + K (Local_Defs.unfold0_tac ctxt (thms @ MRBNF_Def.set_defs_of_mrbnf pre_mrbnf @ [ + MRBNF_Def.map_def_of_mrbnf pre_mrbnf, + #Abs_inverse (snd info) OF @{thms UNIV_I} + ])), + REPEAT_DETERM o resolve_tac ctxt prems, + K (Local_Defs.unfold0_tac ctxt @{thms id_apply}), + rtac ctxt refl + ]; + in mk_map_simps lthy false fs (SOME o MRBNF_Recursor.mk_supp_bound) (K (K NONE)) + (single o HOLogic.mk_Trueprop o mk_bij) bounds mapx tac + end; + + val permute_boundss = map2 (fn (_, tys) => fn permute_simp => + let + val (xs, _) = lthy + |> mk_Frees "x" (map (Term.typ_subst_atomic replace) tys); + val permute_args = Thm.prop_of permute_simp + |> Logic.strip_imp_concl + |> HOLogic.dest_Trueprop + |> snd o HOLogic.dest_eq + |> Logic.unvarify_global + |> snd o Term.strip_comb; + + val bound = map (fn T => + map (fn (_, bound, rec_bounds) => member (op=) (bound::rec_bounds) T) param_vars + ) tys; + in @{map 3} (fn x => fn t => fn bn => if not (exists I bn) then NONE else SOME ( + fold_rev (fn (b, f) => fn t => Term.absfree (dest_Free f) (if b then t else + Term.subst_atomic [(f, HOLogic.id_const (domain_type (fastype_of f)))] t + )) (bn ~~ fs) (Term.absfree (dest_Free x) t) + )) xs permute_args bound end + ) ctors_tys permute_simps; val cmin_UNIV = foldl1 mk_cmin (map (mk_card_of o HOLogic.mk_UNIV) vars); val Cinfinite_card = Goal.prove_sorry lthy [] [] (HOLogic.mk_Trueprop (HOLogic.mk_conj ( @@ -662,12 +722,12 @@ fun create_binder_datatype (spec : spec) lthy = domain_type (domain_type (fastype_of s)) = domain_type (fastype_of h) ) (#SSupps tvsubst_res)); fun mk_supp_bound h = Option.map (fn s => mk_ordLess (mk_card_of s) cmin_UNIV) (mk_supp h); - fun mk_imsupp h T = foldl1 mk_Un (map_filter (fn f => Option.map (fn t => t $ f) ( + fun mk_imsupp h T = SOME (foldl1 mk_Un (map_filter (fn f => Option.map (fn t => t $ f) ( List.find (fn s => domain_type (fastype_of s) = fastype_of h andalso domain_type (fastype_of s) = fastype_of f andalso HOLogic.dest_setT (range_type (fastype_of s)) = T ) (flat (#IImsuppss tvsubst_res)) - )) fs); + )) fs)); fun tac ctxt prems = EVERY1 [ K (Local_Defs.unfold0_tac ctxt (map (Thm.symmetric o snd) (#VVrs tvsubst_res))), EVERY' [ @@ -706,7 +766,7 @@ fun create_binder_datatype (spec : spec) lthy = rtac ctxt refl ] ]; - in mk_map_simps lthy fs mk_supp_bound mk_imsupp (#tvsubst tvsubst_res) tac end; + in mk_map_simps lthy true fs mk_supp_bound mk_imsupp (K []) [] (#tvsubst tvsubst_res) tac end; in (lthy, SOME (tvsubst_res, tvsubst_simps)) end else (lthy, NONE); @@ -716,9 +776,11 @@ fun create_binder_datatype (spec : spec) lthy = val sugar = { map_simps = map_simps, set_simpss = set_simpss, + permute_simps = permute_simps, strong_induct = strong_induct, subst_simps = Option.map snd tvsubst_opt, bsetss = bset_optss, + permute_bounds = permute_boundss, bset_bounds = [], mrbnf = mrbnf, distinct = distinct, @@ -733,6 +795,7 @@ fun create_binder_datatype (spec : spec) lthy = ("induct", [induct], [induct_attrib]), ("set", flat set_simpss, simp), ("map", map_simps, simp), + ("permute", permute_simps, simp), ("distinct", distinct, simp) ] @ the_default [] (Option.map (fn (_, tvsubst_simps) => [("subst", tvsubst_simps, simp)]) tvsubst_opt) ) |> (map (fn (thmN, thms, attrs) => diff --git a/Tools/mrbnf_tvsubst.ML b/Tools/mrbnf_tvsubst.ML index 56772c44..44f41fef 100644 --- a/Tools/mrbnf_tvsubst.ML +++ b/Tools/mrbnf_tvsubst.ML @@ -1477,6 +1477,159 @@ fun create_tvsubst_of_mrbnf qualify fp_res models lthy = )) (#FVars quotient) hs (0 upto nvars - 1) in_IImsuppss ) (#quotient_fps fp_res) in_IImsuppsss hss defss; + val IImsupp_naturalsss = @{map 3} (fn quotient => @{map 3} (fn f => fn SSupp_natural => Option.map (fn def => map2 (fn f' => fn IImsupp => + let + val g = Free ("g", #aT def --> #T quotient); + val goal = mk_Trueprop_eq ( + fst IImsupp $ HOLogic.mk_comp ( + HOLogic.mk_comp (Term.list_comb (#rename quotient, fs), g), + mk_inv f + ), + mk_image f' $ (fst IImsupp $ g) + ); + in Goal.prove_sorry lthy (names (fs @ [g])) f_prems goal (fn {context=ctxt, prems} => EVERY1 [ + K (unfold_thms_tac ctxt (@{thms image_Un image_UN} @ [snd IImsupp])), + TRY o (rtac ctxt @{thm arg_cong2[of _ _ _ _ "(\)"]} THEN' rtac ctxt (the SSupp_natural OF prems)), + EqSubst.eqsubst_tac ctxt [0] [the SSupp_natural OF prems], + K (Local_Defs.unfold0_tac ctxt @{thms image_comp comp_assoc}), + EqSubst.eqsubst_tac ctxt [0] @{thms inv_o_simp1}, + resolve_tac ctxt prems, + K (Local_Defs.unfold0_tac ctxt @{thms o_id}), + K (Local_Defs.unfold0_tac ctxt @{thms comp_def}), + EqSubst.eqsubst_tac ctxt [0] (maps #FVars_renames (#quotient_fps fp_res)), + REPEAT_DETERM o resolve_tac ctxt (refl :: prems) + ]) end + ) fs (#IImsupps def))) fs) (#quotient_fps fp_res) SSupp_naturalss defss; + + fun SELECT_GOALS n tac i st = + if Thm.nprems_of st = 1 andalso i = 1 then tac st + else (PRIMITIVE (Goal.restrict i n) THEN tac THEN PRIMITIVE (Goal.unrestrict i)) st; + + val tvsubst_rrenames = + let + val (ts, _) = lthy + |> mk_Frees "t" (map #T (#quotient_fps fp_res)); + fun mk_goals comb = @{map 3} (fn quotient => fn tvsubst => fn t => + let + val hs' = map_filter I (maps (map2 (fn f => Option.map (fn h => HOLogic.mk_comp ( + HOLogic.mk_comp (Term.list_comb (#rename quotient, fs), h), + mk_inv f + ))) fs) hss); + in HOLogic.mk_eq ( + comb (Term.list_comb (#rename quotient, fs)) (Term.list_comb (fst tvsubst, some_hs)) t, + comb (Term.list_comb (fst tvsubst, hs')) (Term.list_comb (#rename quotient, fs)) t + ) end + ) (#quotient_fps fp_res) tvsubsts ts; + val As = map (fn i => + foldl1 mk_Un (map2 (fn f => fn def => + fst (nth (#IImsupps def) i) $ f + ) some_hs some_defs) + ) (0 upto nvars - 1); + + val goal = HOLogic.mk_Trueprop (foldr1 HOLogic.mk_conj ( + mk_goals (fn t1 => fn t2 => fn t => t1 $ (t2 $ t)) + )); + val thms = split_conj (length mrbnfs) (Goal.prove_sorry lthy (names (fs @ some_hs @ ts)) (f_prems @ f'_prems) goal (fn {context=ctxt, prems} => + let val (f_prems, f'_prems) = chop (length f_prems) prems; + in EVERY1 [ + rtac ctxt (infer_instantiate' ctxt ( + map (SOME o Thm.cterm_of ctxt) As @ replicate (length mrbnfs) NONE @ map (SOME o Thm.cterm_of ctxt) ts + ) (#fresh_co_induct (#inner (hd (#quotient_fps fp_res))))), + SELECT_GOALS (length As) (EVERY1 [ + K (Local_Defs.unfold0_tac ctxt (@{thm comp_def} :: maps (map snd o #IImsupps) some_defs)), + REPEAT_DETERM o resolve_tac ctxt ( + @{thms ordLeq_refl cmin1 cmin2 card_of_Card_order} + @ map (fn thm => @{thm ordLess_ordLeq_trans} OF [thm]) f'_prems + @ maps (fn mrbnf => [ + MRBNF_Def.Un_bound_of_mrbnf mrbnf, MRBNF_Def.UNION_bound_of_mrbnf mrbnf + ]) mrbnfs + @ maps #card_of_FVars_bound_UNIVs (#quotient_fps fp_res) + ) + ]), + EVERY' (@{map 9} (fn mrbnf => fn quotient => fn defs => fn tvsubst_not_isVVr => fn isVVr_renames => fn SSupp_naturals => fn IImsupp_naturalss => fn rrename_VVrs => fn tvsubst_VVrs => + let val n = length (map_filter I defs); + in Subgoal.FOCUS_PREMS (fn {context=ctxt, prems=IHs, ...} => EVERY1 [ + REPEAT_DETERM_N n o rtac ctxt @{thm case_split[rotated]}, + EqSubst.eqsubst_tac ctxt [0] [#rename_ctor (#inner quotient) OF f_prems], + EqSubst.eqsubst_tac ctxt [0] [Drule.rotate_prems (~1 - n) tvsubst_not_isVVr], + resolve_tac ctxt IHs, + REPEAT_DETERM o assume_tac ctxt, + REPEAT_DETERM o resolve_tac ctxt f'_prems, + REPEAT_DETERM o (rtac ctxt @{thm disjointI} THEN' eresolve_tac ctxt IHs), + EqSubst.eqsubst_tac ctxt [0] [Drule.rotate_prems (~1 - n) tvsubst_not_isVVr], + rtac ctxt (iffD2 OF [#noclash_rename quotient OF f_prems]), + resolve_tac ctxt IHs, + REPEAT_DETERM o EVERY' [ + EqSubst.eqsubst_tac ctxt [0] [#rename_ctor (#inner quotient) RS sym OF f_prems], + EqSubst.eqsubst_tac ctxt [0] (map_filter (Option.map (fn thm => thm OF f_prems)) isVVr_renames), + assume_tac ctxt + ], + REPEAT_DETERM o EVERY' [ + EqSubst.eqsubst_tac ctxt [0] (map_filter (Option.map (fn thm => thm OF f_prems)) SSupp_naturals), + rtac ctxt @{thm ordLeq_ordLess_trans[OF card_of_image]}, + resolve_tac ctxt f'_prems + ], + REPEAT_DETERM o EVERY' [ + REPEAT_DETERM1 o EVERY' [ + EqSubst.eqsubst_tac ctxt [0] (MRBNF_Def.set_map_of_mrbnf mrbnf @ flat (map_filter I IImsupp_naturalss)), + REPEAT_DETERM o resolve_tac ctxt (@{thms supp_id_bound bij_id} @ f_prems) + ], + K (Local_Defs.unfold0_tac ctxt @{thms image_Un[symmetric]}), + rtac ctxt @{thm trans[OF image_Int[OF bij_is_inj, symmetric]]}, + resolve_tac ctxt f_prems, + rtac ctxt @{thm iffD2[OF image_is_empty]}, + rtac ctxt @{thm disjointI}, + eresolve_tac ctxt IHs + ], + rtac ctxt (trans OF [#rename_ctor (#inner quotient) OF f_prems]), + rtac ctxt (mk_arg_cong lthy 1 (#ctor quotient)), + rtac ctxt (trans OF [MRBNF_Def.map_comp_of_mrbnf mrbnf]), + REPEAT_DETERM o resolve_tac ctxt (@{thms supp_id_bound bij_id} @ f_prems), + rtac ctxt sym, + rtac ctxt (trans OF [MRBNF_Def.map_comp_of_mrbnf mrbnf]), + REPEAT_DETERM o resolve_tac ctxt (@{thms supp_id_bound bij_id} @ f_prems), + K (Local_Defs.unfold0_tac ctxt @{thms id_o o_id}), + rtac ctxt (MRBNF_Def.map_cong0_of_mrbnf mrbnf), + REPEAT_DETERM o resolve_tac ctxt (@{thms supp_id_bound bij_id refl} @ f_prems), + REPEAT_DETERM o EVERY' [ + rtac ctxt @{thm trans[OF comp_apply]}, + rtac ctxt sym, + rtac ctxt @{thm trans[OF comp_apply]}, + eresolve_tac ctxt IHs + ], + EVERY' (map_filter (Option.map (fn def => EVERY' [ + K (Local_Defs.unfold0_tac ctxt [snd (#isVVr def)]), + etac ctxt exE, + etac ctxt @{thm subst[OF sym]}, + EqSubst.eqsubst_tac ctxt [0] (map_filter I rrename_VVrs), + REPEAT_DETERM o resolve_tac ctxt f_prems, + EqSubst.eqsubst_tac ctxt [0] (map_filter I tvsubst_VVrs), + REPEAT_DETERM o resolve_tac ctxt f'_prems, + EqSubst.eqsubst_tac ctxt [0] (map_filter I tvsubst_VVrs), + REPEAT_DETERM o EVERY' [ + EqSubst.eqsubst_tac ctxt [0] (map_filter (Option.map (fn thm => thm OF f_prems)) SSupp_naturals), + rtac ctxt @{thm ordLeq_ordLess_trans[OF card_of_image]}, + resolve_tac ctxt f'_prems + ], + K (Local_Defs.unfold0_tac ctxt @{thms comp_def}), + EqSubst.eqsubst_tac ctxt [0] @{thms inv_simp1}, + resolve_tac ctxt f_prems, + rtac ctxt refl + ])) (rev defs)) + ]) ctxt end + ) mrbnfs (#quotient_fps fp_res) defss tvsubst_not_isVVrs isVVr_renamess SSupp_naturalss IImsupp_naturalsss rrename_VVrss tvsubst_VVrss) + ] end + )); + + val goals = map HOLogic.mk_Trueprop (mk_goals (fn t1 => fn t2 => fn _ => HOLogic.mk_comp (t1, t2))); + in map2 (fn thm => fn goal => Goal.prove_sorry lthy (names (fs @ some_hs)) (f_prems @ f'_prems) goal (fn {context=ctxt, prems} => EVERY1 [ + rtac ctxt ext, + rtac ctxt @{thm trans[OF comp_apply]}, + rtac ctxt sym, + rtac ctxt @{thm trans[OF comp_apply]}, + rtac ctxt (thm RS sym OF prems) + ])) thms goals end; + (*val FFVars_tvsubsts = @{map 8} (fn FVars => fn i => fn f => fn tvsubst_VVr => fn FVars_VVr => fn not_isVVr_free => fn IImsupp_Diff => Option.map (fn def => let val t = Free ("t", #T quotient); @@ -1583,12 +1736,19 @@ fun create_tvsubst_of_mrbnf qualify fp_res models lthy = [("SSupp_VVr_empty", maps (map_filter I) SSupp_VVr_emptiess), ("SSupp_VVr_bound", maps (map_filter I) SSupp_VVr_boundss), ("in_IImsupp", flat (maps (map_filter I) in_IImsuppsss)), + ("is_VVr_rrename", maps (map_filter I) isVVr_renamess), + ("rrename_VVr", maps (map_filter I) rrename_VVrss), + ("SSupp_natural", maps (map_filter I) SSupp_naturalss), + ("SSupp_comp_rename_bound", maps (map_filter (Option.map #SSupp_comp_rename_bound)) SSupp_compss), + ("SSupp_comp_bound", maps (map_filter (Option.map #SSupp_comp_bound)) SSupp_compss), ("eta_set_empties", flat (maps (map_filter I) eta_set_emptiess)), ("FVars_VVr", flat (maps (map_filter I) FVars_VVrss)), ("tvsubst_VVr", maps (map_filter I) tvsubst_VVrss), ("tvsubst_cctor_not_isVVr", tvsubst_not_isVVrs), + ("rrename_tvsubst", tvsubst_rrenames), ("not_isVVr_free", maps (map_filter I) not_isVVr_freess), - ("IImsupp_Diff", maps (map_filter I) IImsupp_Diffss) + ("IImsupp_Diff", maps (map_filter I) IImsupp_Diffss), + ("IImsupp_natural", flat (maps (map_filter I) IImsupp_naturalsss)) (*("FFVars_tvsubst", map_filter I FFVars_tvsubsts)*) ] |> (map (fn (thmN, thms) => ((Binding.qualify true (short_type_name (fst (dest_Type (#T (hd (#quotient_fps fp_res)))))) diff --git a/html/Binders/.browser_info/build_uuid b/html/Binders/.browser_info/build_uuid index 870be435..60934cd8 100644 --- a/html/Binders/.browser_info/build_uuid +++ b/html/Binders/.browser_info/build_uuid @@ -1 +1 @@ -785da145-7f99-4401-8912-50097c36170b \ No newline at end of file +2aae4740-5a4c-458c-b26c-cca8e1759a7e \ No newline at end of file diff --git a/html/Binders/MRBNF_FP.html b/html/Binders/MRBNF_FP.html index 4fdba92e..cde964aa 100644 --- a/html/Binders/MRBNF_FP.html +++ b/html/Binders/MRBNF_FP.html @@ -361,13 +361,19 @@

Theory MRBNF_FP

unfolding Int_Un_distrib fun_eq_iff o_apply id_apply by blast +named_theorems refresh_extends +named_theorems refresh_smalls +named_theorems refresh_simps +named_theorems refresh_intros +named_theorems refresh_elims + ML ‹ local open BNF_Util open BNF_FP_Util in -fun refreshability_tac verbose supps renames instss G_thm eqvt_thm extend_thms small_thms simp_thms intro_thms elim_thms ctxt = +fun refreshability_tac_common verbose supps instss G_thm eqvt_thm extend_thms small_thms simp_thms intro_thms elim_thms ctxt = let val n = length supps; fun case_tac NONE _ prems ctxt = HEADGOAL (Method.insert_tac ctxt prems THEN' @@ -389,15 +395,17 @@

Theory MRBNF_FP

|> Library.foldl1 (HOLogic.mk_binop const_name‹sup›); val fresh = infer_instantiate' ctxt [SOME (Thm.cterm_of ctxt B), SOME (Thm.cterm_of ctxt A)] @{thm extend_fresh}; + val _ = (verbose ? @{print tracing}) fresh fun case_inner_tac fs fprems ctxt = - let + let + val _ = (verbose ? @{print tracing}) fs val f = hd fs |> snd |> Thm.term_of; val ex_f = infer_instantiate' ctxt [NONE, SOME (Thm.cterm_of ctxt f)] exI; val ex_B' = infer_instantiate' ctxt [NONE, SOME (Thm.cterm_of ctxt (mk_image f $ B))] exI; val args = params |> map (snd #> Thm.term_of); val xs = @{map 2} (fn i => fn a => Thm.cterm_of ctxt - (case i of SOME i => nth renames i $ f $ a | NONE => a)) insts args; + (case i of SOME t => t $ f $ a | NONE => a)) insts args; val _ = fprems |> map (Thm.pretty_thm ctxt #> verbose ? @{print tracing}); val eqvt_thm = eqvt_thm OF take 2 fprems; val extra_assms = assms RL (eqvt_thm :: extend_thms); @@ -417,24 +425,40 @@

Theory MRBNF_FP

addSEs elim_thms) 0 10) THEN_ALL_NEW (SELECT_GOAL (print_tac ctxt "auto failed"))) end; val small_ctxt = ctxt addsimps small_thms; - in - HEADGOAL (rtac ctxt (fresh RS exE) THEN' - SELECT_GOAL (auto_tac (small_ctxt addsimps [hd defs])) THEN' - REPEAT_DETERM_N 2 o (asm_simp_tac small_ctxt) THEN' - SELECT_GOAL (unfold_tac ctxt @{thms Int_Un_distrib Un_empty}) THEN' - REPEAT_DETERM o etac ctxt conjE THEN' + in EVERY1 [ + rtac ctxt (fresh RS exE), + if verbose then K (print_tac ctxt "after_fresh") else K all_tac, + SELECT_GOAL (auto_tac (small_ctxt addsimps [hd defs])), + if verbose then K (print_tac ctxt "after_auto") else K all_tac, + REPEAT_DETERM_N 2 o (asm_simp_tac small_ctxt), + SELECT_GOAL (unfold_tac ctxt @{thms Int_Un_distrib Un_empty}), + REPEAT_DETERM o etac ctxt conjE, + if verbose then K (print_tac ctxt "pre_case_inner_tac") else K all_tac, Subgoal.SUBPROOF (fn focus => - case_inner_tac (#params focus) (#prems focus) (#context focus)) ctxt) - end; + case_inner_tac (#params focus) (#prems focus) (#context focus)) ctxt + ] end; in - unfold_tac ctxt @{thms conj_disj_distribL ex_disj_distrib} THEN - HEADGOAL ( - rtac ctxt (G_thm RSN (2, cut_rl)) THEN' - REPEAT_ALL_NEW (eresolve_tac ctxt @{thms exE conjE disj_forward}) THEN' + unfold_tac ctxt @{thms conj_disj_distribL ex_disj_distrib} THEN EVERY1 [ + rtac ctxt (G_thm RSN (2, cut_rl)), + REPEAT_ALL_NEW (eresolve_tac ctxt @{thms exE conjE disj_forward}), + if verbose then K (print_tac ctxt "pre_case_tac") else K all_tac, EVERY' (map (fn insts => Subgoal.SUBPROOF (fn focus => - case_tac insts (#params focus) (#prems focus) (#context focus)) ctxt) instss)) + case_tac insts (#params focus) (#prems focus) (#context focus)) ctxt) instss) + ] end; +fun refreshability_tac_internal verbose supps instss G_thm eqvt_thm smalls simps ctxt = + refreshability_tac_common verbose supps instss G_thm eqvt_thm + (Named_Theorems.get ctxt "MRBNF_FP.refresh_extends") + (smalls @ Named_Theorems.get ctxt "MRBNF_FP.refresh_smalls") + (simps @ Named_Theorems.get ctxt "MRBNF_FP.refresh_simps") + (Named_Theorems.get ctxt "MRBNF_FP.refresh_intros") + (Named_Theorems.get ctxt "MRBNF_FP.refresh_elims") ctxt; + +fun refreshability_tac verbose supps renames instss = + let val instss' = map (Option.map (map (Option.map (nth renames)))) instss + in refreshability_tac_common verbose supps instss' end + end; › diff --git a/html/Binders/MRBNF_Recursor.html b/html/Binders/MRBNF_Recursor.html index 9acfbe49..c74c1756 100644 --- a/html/Binders/MRBNF_Recursor.html +++ b/html/Binders/MRBNF_Recursor.html @@ -27,6 +27,18 @@

Theory MRBNF_Recursor

declare [[inductive_internals]] +named_theorems equiv +named_theorems equiv_commute +named_theorems equiv_simps + +declare Un_iff[equiv_simps] de_Morgan_disj[equiv_simps] + inj_image_mem_iff[OF bij_is_inj, equiv_simps] + singleton_iff[equiv_simps] image_empty[equiv_simps] + Int_Un_distrib[equiv_simps] Un_empty[equiv_simps] + image_is_empty[equiv_simps] image_Int[OF bij_is_inj, symmetric, equiv_simps] + inj_eq[OF bij_is_inj, equiv_simps] inj_eq[OF bij_is_inj, equiv_simps] + image_insert[equiv_simps] insert_iff[equiv_simps] notin_empty_eq_True[equiv_simps] + context begin ML_file ‹../Tools/binder_induction.ML› end @@ -37,7 +49,8 @@

Theory MRBNF_Recursor

ML_file "../Tools/parser.ML" -end +end + \ No newline at end of file diff --git a/html/Binders/Tools/binder_induction.ML.html b/html/Binders/Tools/binder_induction.ML.html index 55ad78f0..b677f97b 100644 --- a/html/Binders/Tools/binder_induction.ML.html +++ b/html/Binders/Tools/binder_induction.ML.html @@ -3,13 +3,13 @@ -File ‹../Tools/binder_induction.ML› +File ‹Tools/binder_induction.ML›
-

File ‹../Tools/binder_induction.ML›

+

File ‹Tools/binder_induction.ML›

structure Binder_Induction =
diff --git a/html/Binders/Tools/binder_inductive.ML.html b/html/Binders/Tools/binder_inductive.ML.html
index 0e841be8..4157f442 100644
--- a/html/Binders/Tools/binder_inductive.ML.html
+++ b/html/Binders/Tools/binder_inductive.ML.html
@@ -3,19 +3,23 @@
 
 
 
-File ‹../Tools/binder_inductive.ML›
+File ‹Tools/binder_inductive.ML›
 
 
 
 
 

-
File ‹../Tools/binder_inductive.ML›

+
File ‹Tools/binder_inductive.ML›

 

 
 
signature BINDER_INDUCTIVE =
 sig
-  val binder_inductive_cmd: (string * (string * string list) list option) * (string list option * string list option)
+  datatype options = No_Equiv | No_Refresh | Verbose
+
+  val binder_inductive_cmd: ((options list * string) * (string * string list) list option) * (string list option * string list option)
     -> local_theory -> Proof.state;
+
+  val config_parser: options list parser;
 end
 
 structure Binder_Inductive : BINDER_INDUCTIVE =
@@ -36,7 +40,9 @@ 
File ‹../Tools/binder_inductive.ML›

 fun mk_insert x S =
   Const (@{const_name Set.insert}, fastype_of x --> fastype_of S --> fastype_of S) $ x $ S;
 
-fun binder_inductive_cmd ((pred_name, binds_opt), perms_supps) no_defs_lthy =
+datatype options = No_Equiv | No_Refresh | Verbose
+
+fun binder_inductive_cmd (((options, pred_name), binds_opt), perms_supps) no_defs_lthy =
   let
     val binds = the_default [] binds_opt;
 
@@ -88,6 +94,10 @@ 
File ‹../Tools/binder_inductive.ML›

 
     val param_Ts = map (Term.typ_subst_TVars subst) param_Ts;
 
+    val param_sugars = map (fn T => Option.mapPartial (fn s =>
+      MRBNF_Sugar.binder_sugar_of no_defs_lthy s
+    ) (try (fn () => fst (dest_Type T)) ())) param_Ts;
+
     fun collect_binders (Free _) = []
       | collect_binders (Var _) = []
       | collect_binders (Bound _) = []
@@ -387,17 +397,21 @@ 
File ‹../Tools/binder_inductive.ML›

     val perms_specified = map (fn Inl _ => false | _ => true) raw_perms;
     val supps_specified = map (fn Inl _ => false | _ => true) raw_supps;
     val one_specified = map2 (fn a => fn b => a orelse b) perms_specified supps_specified;
+
     fun keep_perm xs = cond_keep xs perms_specified;
     fun keep_supp xs = cond_keep xs supps_specified;
     fun keep_both xs = cond_keep xs one_specified;
     fun keep_binders xs = cond_keep xs binders_specified;
 
+    fun option x t f = if member (op=) options x then t else f;
+
     val defs = map snd (perms @ supps);
+    val verbose = member (op=) options Verbose;
 
     val goals = map (single o rpair []) (
       keep_perm perm_id0_goals @ keep_perm perm_comp_goals @ keep_both supp_seminat_goals
       @ keep_both perm_support_goals @ keep_supp supp_small_goals @ flat (keep_binders B_small_goals)
-      @ [G_equiv_goal, G_refresh_goal]
+      @ option No_Equiv [G_equiv_goal] [] @ option No_Refresh [G_refresh_goal] []
     );
     fun after_qed thmss lthy =
       let
@@ -459,15 +473,14 @@ 
File ‹../Tools/binder_inductive.ML›

         val m2 = length (filter not one_specified);
         val m3 = length (filter not supps_specified);
         val m4 = length (filter not binders_specified);
-        val (((((((perm_id0s, perm_comps), supp_seminats), perm_supports), supp_smalls), B_smalls), G_equiv), G_refresh) = map hd thmss
+        val (((((((perm_id0s, perm_comps), supp_seminats), perm_supports), supp_smalls), B_smalls), G_equivs), G_refreshs) = map hd thmss
           |> chop (n - m)
           ||>> chop (n - m)
           ||>> chop (n - m2)
           ||>> chop (n - m2)
           ||>> chop (num_vars * (n - m3))
           ||>> chop (length bind_ts - m4)
-          ||>> apfst hd o chop 1
-          ||> hd;
+          ||>> chop (option No_Equiv 1 0);
 
         fun map_id0_of_mr_bnf (Inl mrbnf) = [MRBNF_Def.map_id0_of_mrbnf mrbnf]
           | map_id0_of_mr_bnf (Inr (Inl bnf)) = [BNF_Def.map_id0_of_bnf bnf]
@@ -615,6 +628,138 @@ 
File ‹../Tools/binder_inductive.ML›

 
         val perm_ids = map (fn thm => thm RS fun_cong RS @{thm trans[OF _ id_apply]}) perm_id0s;
 
+        val G_equiv = if member (op=) options No_Equiv then hd G_equivs else
+          Goal.prove_sorry lthy [] [] G_equiv_goal (fn {context=ctxt, ...} => EVERY1 [
+            K (Local_Defs.unfold0_tac ctxt [snd G]),
+            REPEAT_DETERM o EVERY' [
+              TRY o etac ctxt @{thm disj_forward},
+              REPEAT_DETERM o eresolve_tac ctxt [exE, conjE],
+              REPEAT_DETERM_N (length param_Ts + 1) o etac ctxt @{thm subst[OF sym]},
+              Subgoal.FOCUS_PARAMS (fn {context=ctxt, params, ...} =>
+                let
+                  val (fs, args) = map (Thm.term_of o snd) params
+                    |> drop 2
+                    |> chop 1
+                    ||> drop (length param_Ts);
+                  val (mr_bnfs, ts) = apfst (map snd o flat) (split_list (map (fn x => case find_index (curry (op=) (fastype_of x)) param_Ts of
+                    ~1 => (case find_index (curry (op=) (fastype_of x)) var_Ts of
+                      ~1 => apsnd (fn t => t $ x) (build_permute_for fs var_Ts (fastype_of x))
+                      | n => ([], nth fs n $ x))
+                    | n => ([], Term.list_comb (fst (nth perms n), fs) $ x)
+                  ) args));
+                  val equiv_commute = Named_Theorems.get ctxt "MRBNF_Recursor.equiv_commute";
+                  val equiv = Named_Theorems.get ctxt "MRBNF_Recursor.equiv" @ equiv_commute;
+                  val equiv_simps = Named_Theorems.get ctxt "MRBNF_Recursor.equiv_simps"
+                  val monos = Inductive.get_monos ctxt
+                  val set_maps = maps set_map_of_mr_bnf mr_bnfs;
+                in EVERY1 [
+                  EVERY' (map (fn t => rtac ctxt (
+                    infer_instantiate' ctxt [NONE, SOME (Thm.cterm_of ctxt t)] exI
+                  )) ts),
+                  SELECT_GOAL (Local_Defs.unfold0_tac ctxt (map snd perms)),
+                  rtac ctxt conjI,
+                  SELECT_GOAL (Local_Defs.unfold0_tac ctxt (@{thms image_Un} @ equiv_simps)),
+                  REPEAT_DETERM o rtac ctxt @{thm arg_cong2[of _ _ _ _ "(∪)"]},
+                  REPEAT_DETERM1 o EVERY' [
+                    resolve_tac ctxt @{thms image_single[symmetric] image_empty refl} ORELSE' EVERY' [
+                      resolve_tac ctxt (map (fn thm => thm RS sym) (set_maps @ equiv_simps) @ equiv_simps),
+                      REPEAT_DETERM o assume_tac ctxt
+                    ]
+                  ],
+                  K (Local_Defs.unfold0_tac ctxt @{thms id_apply}),
+                  K (Local_Defs.unfold0_tac ctxt @{thms id_def[symmetric]}),
+                  REPEAT_DETERM o EVERY' [
+                    TRY o rtac ctxt conjI,
+                    SELECT_GOAL (EVERY1 [
+                      REPEAT_DETERM1 o FIRST' [
+                        assume_tac ctxt,
+                        eresolve_tac ctxt [conjE],
+                        resolve_tac ctxt @{thms conjI refl TrueI bij_imp_bij_inv supp_inv_bound},
+                        rtac ctxt impI THEN' eresolve_tac ctxt @{thms injD[OF bij_is_inj, rotated -1]},
+                        EVERY' [
+                          SELECT_GOAL (Local_Defs.unfold0_tac ctxt (map_filter (try (fn thm => thm RS sym)) equiv_commute)),
+                          REPEAT_DETERM1 o EVERY' [
+                            EqSubst.eqsubst_tac ctxt [0] (map (Local_Defs.unfold0 ctxt (map snd perms)) perm_comps),
+                            REPEAT_DETERM1 o (assume_tac ctxt ORELSE' resolve_tac ctxt @{thms supp_inv_bound bij_imp_bij_inv})
+                          ],
+                          K (Local_Defs.unfold0_tac ctxt @{thms inv_o_simp1 inv_o_simp2 inv_simp1 inv_simp2}),
+                          K (Local_Defs.unfold0_tac ctxt (map (Local_Defs.unfold0 ctxt (map snd perms)) perm_ids)),
+                          assume_tac ctxt
+                        ],
+                        eresolve_tac ctxt (map_filter (try (fn thm => Drule.rotate_prems ~1 thm)) equiv),
+                        CHANGED o SELECT_GOAL (Local_Defs.unfold0_tac ctxt (equiv @ equiv_simps @ flat (map_filter (Option.map #permute_simps) param_sugars))),
+                        eresolve_tac ctxt (map (fn thm => Drule.rotate_prems ~1 (thm RS mp)) monos),
+                        resolve_tac ctxt monos,
+                        CHANGED o SELECT_GOAL (Local_Defs.unfold0_tac ctxt (flat (map_filter (Option.map (map (fn thm => thm RS sym) o #permute_simps)) param_sugars)))
+                      ]
+                    ])
+                  ]
+                ] end
+              ) ctxt
+            ]
+          ]);
+        val _ = (verbose ? @{print}) G_equiv
+
+        val G_refresh = if member (op=) options No_Refresh then hd (G_refreshs) else
+          let
+            val var_rules = map (fn thm =>
+              let val t = Logic.unvarify_global (Thm.prop_of thm)
+              in (map Free (rev (Term.add_frees t [])), t) end
+            ) intrs;
+
+            fun collect_permutes _ (Free _) = []
+              | collect_permutes _ (Var _) = []
+              | collect_permutes _ (Bound _) = []
+              | collect_permutes _ (Const _) = []
+              | collect_permutes vars (Abs (_, _, t)) = collect_permutes vars t
+              | collect_permutes vars (t as (t1 $ t2)) = case try (dest_Type o Term.body_type o fastype_of) t of
+                NONE => collect_permutes vars t1 @ collect_permutes vars t2
+                | SOME (s, _) => (case MRBNF_Sugar.binder_sugar_of no_defs_lthy s of
+                    NONE => collect_permutes vars t1 @ collect_permutes vars t2
+                    | SOME sugar =>
+                      let val (ctor, args) = Term.strip_comb t
+                      in case (map_filter I (map_index (fn (i, (t, _)) =>
+                          if (op=) (apply2 (fst o dest_Const) (t, ctor)) then
+                            SOME i else NONE
+                          ) (#ctors sugar))) of
+                        [] => collect_permutes vars t1 @ collect_permutes vars t2
+                        | ctor_idx::_ => (case nth (hd (#bsetss sugar)) ctor_idx of
+                          NONE => maps (collect_permutes vars) args
+                          | SOME _ =>
+                            let
+                              val arg_Ts = Term.binder_types (fastype_of ctor);
+                              val permute_bounds = nth (#permute_bounds sugar) ctor_idx;
+                              val var_args = map (fn t => if member (op=) vars t then SOME t else NONE) args;
+                              val result = map_filter I (map2 (fn NONE => K NONE
+                                | SOME perm => Option.map (fn x => (x, perm))
+                              ) permute_bounds var_args);
+
+                              val tyenv = @{fold 2} (fn NONE => K I | SOME perm => fn T =>
+                                Sign.typ_match (Proof_Context.theory_of no_defs_lthy) (body_type (fastype_of perm), T)
+                              ) permute_bounds arg_Ts Vartab.empty;
+
+                            in map (apsnd (Envir.subst_term (tyenv, Vartab.empty))) result
+                              @ maps (collect_permutes vars) args
+                            end
+                          )
+                      end
+                    );
+              fun isNONE NONE = true
+                | isNONE _ = false
+              val permute_bounds = map (distinct (op=) o uncurry collect_permutes) var_rules;
+              val matrix = map2 (fn (vars, _) => fn perms =>
+                let val inner = map (AList.lookup (op=) perms) vars;
+                in if forall isNONE inner then NONE else SOME inner end
+              ) var_rules permute_bounds;
+              val _ = (verbose ? @{print}) (map (Option.map (map (Option.map (Thm.cterm_of lthy)))) matrix)
+          in Goal.prove_sorry lthy [] [] G_refresh_goal (fn {context=ctxt, ...} => EVERY1 [
+            K (Local_Defs.unfold0_tac ctxt (snd G :: map snd perms)),
+            Subgoal.FOCUS (fn {context=ctxt, prems, ...} =>
+              refreshability_tac_internal verbose (map fst supps) matrix (nth prems 2) (nth prems 1) supp_smalls (map snd supps) ctxt
+            ) ctxt
+          ]) end;
+        val _ = (verbose ? @{print}) G_refresh
+
         fun mk_induct mono = Drule.rotate_prems ~1 (
           apply_n @{thm le_funD} n (@{thm lfp_induct} OF [mono])
             RS @{thm le_boolD}
@@ -1023,7 +1168,15 @@ 
File ‹../Tools/binder_inductive.ML›

     >> (fn ps => fold extract_perm_supp ps (NONE, NONE))
   || Scan.succeed (NONE, NONE);
 
-val binder_inductive_parser = Parse.name -- Scan.option (
+val options_parser = Parse.group (fn () => "option")
+  ((Parse.reserved "no_auto_equiv" >> K No_Equiv)
+    || (Parse.reserved "no_auto_refresh" >> K No_Refresh)
+    || (Parse.reserved "verbose" >> K Verbose))
+
+val config_parser = Scan.optional (@{keyword "("} |--
+  Parse.!!! (Parse.list1 options_parser) --| @{keyword ")"}) []
+
+val binder_inductive_parser = config_parser -- Parse.name -- Scan.option (
     @{keyword where} |-- Parse.enum1 "|" (Parse.name --| @{keyword binds} -- Parse.and_list Parse.term)
   ) -- parse_perm_supps
 
@@ -1031,7 +1184,8 @@ 
File ‹../Tools/binder_inductive.ML›

   Outer_Syntax.local_theory_to_proof command_keyword‹make_binder_inductive› "derive strengthened induction theorems for inductive predicates"
     (binder_inductive_parser >> binder_inductive_cmd);
 
-end

+end
+
\ No newline at end of file diff --git a/html/Binders/Tools/binder_inductive_combined.ML.html b/html/Binders/Tools/binder_inductive_combined.ML.html index 869619ea..c79f25e3 100644 --- a/html/Binders/Tools/binder_inductive_combined.ML.html +++ b/html/Binders/Tools/binder_inductive_combined.ML.html @@ -3,13 +3,13 @@ -File ‹../Tools/binder_inductive_combined.ML› +File ‹Tools/binder_inductive_combined.ML›
-

File ‹../Tools/binder_inductive_combined.ML›

+

File ‹Tools/binder_inductive_combined.ML›

structure Binder_Inductive_Combined =
@@ -17,21 +17,23 @@ 
File ‹../Tools/binder_inductive_combined.ML›

 
 fun ind_decl co args =
   let
-    val names = map (fn (x, _, _) => x) (fst (Parse.vars args));
-    val (inductive, rest) = Inductive.gen_ind_decl Inductive.add_ind_def co args;
+    val (options, rest) = Binder_Inductive.config_parser args;
+    val names = map (fn (x, _, _) => x) (fst (Parse.vars rest));
+    val (inductive, rest) = Inductive.gen_ind_decl Inductive.add_ind_def co rest;
   in (fn lthy =>
     let
       val lthy = snd (Local_Theory.begin_nested lthy);
       val lthy = inductive lthy;
       val (lthy, old_lthy) = `Local_Theory.end_nested lthy;
-      val state = Binder_Inductive.binder_inductive_cmd ((Binding.name_of (hd names), NONE), (NONE, NONE)) lthy
+      val state = Binder_Inductive.binder_inductive_cmd (((options, Binding.name_of (hd names)), NONE), (NONE, NONE)) lthy
     in state end, rest) end;
 
 val _ =
   Outer_Syntax.local_theory_to_proof command_keyword‹binder_inductive› "derive strengthened induction theorems for inductive predicates"
     (ind_decl false);
 
-end
+end + \ No newline at end of file diff --git a/html/Binders/Tools/mrbnf_comp.ML.html b/html/Binders/Tools/mrbnf_comp.ML.html index c6d0ad04..acf447e9 100644 --- a/html/Binders/Tools/mrbnf_comp.ML.html +++ b/html/Binders/Tools/mrbnf_comp.ML.html @@ -3,13 +3,13 @@ -File ‹../Tools/mrbnf_comp.ML› +File ‹Tools/mrbnf_comp.ML›
-

File ‹../Tools/mrbnf_comp.ML›

+

File ‹Tools/mrbnf_comp.ML›

signature MRBNF_COMP =
diff --git a/html/Binders/Tools/mrbnf_comp_tactics.ML.html b/html/Binders/Tools/mrbnf_comp_tactics.ML.html
index f17f43dd..7aa698fc 100644
--- a/html/Binders/Tools/mrbnf_comp_tactics.ML.html
+++ b/html/Binders/Tools/mrbnf_comp_tactics.ML.html
@@ -3,13 +3,13 @@
 
 
 
-File ‹../Tools/mrbnf_comp_tactics.ML›
+File ‹Tools/mrbnf_comp_tactics.ML›
 
 
 
 
 

-
File ‹../Tools/mrbnf_comp_tactics.ML›

+
File ‹Tools/mrbnf_comp_tactics.ML›

 

 
 
signature MRBNF_COMP_TACTICS =
diff --git a/html/Binders/Tools/mrbnf_def.ML.html b/html/Binders/Tools/mrbnf_def.ML.html
index a10770cb..36a884a8 100644
--- a/html/Binders/Tools/mrbnf_def.ML.html
+++ b/html/Binders/Tools/mrbnf_def.ML.html
@@ -3,13 +3,13 @@
 
 
 
-File ‹../Tools/mrbnf_def.ML›
+File ‹Tools/mrbnf_def.ML›
 
 
 
 
 

-
File ‹../Tools/mrbnf_def.ML›

+
File ‹Tools/mrbnf_def.ML›

 

 
 
signature MRBNF_DEF =
diff --git a/html/Binders/Tools/mrbnf_def_tactics.ML.html b/html/Binders/Tools/mrbnf_def_tactics.ML.html
index f3911f1d..042cd88c 100644
--- a/html/Binders/Tools/mrbnf_def_tactics.ML.html
+++ b/html/Binders/Tools/mrbnf_def_tactics.ML.html
@@ -3,13 +3,13 @@
 
 
 
-File ‹../Tools/mrbnf_def_tactics.ML›
+File ‹Tools/mrbnf_def_tactics.ML›
 
 
 
 
 

-
File ‹../Tools/mrbnf_def_tactics.ML›

+
File ‹Tools/mrbnf_def_tactics.ML›

 

 
 
signature MRBNF_DEF_TACTICS =
diff --git a/html/Binders/Tools/mrbnf_fp.ML.html b/html/Binders/Tools/mrbnf_fp.ML.html
index bc6020f6..6ff4a789 100644
--- a/html/Binders/Tools/mrbnf_fp.ML.html
+++ b/html/Binders/Tools/mrbnf_fp.ML.html
@@ -3,13 +3,13 @@
 
 
 
-File ‹../Tools/mrbnf_fp.ML›
+File ‹Tools/mrbnf_fp.ML›
 
 
 
 
 

-
File ‹../Tools/mrbnf_fp.ML›

+
File ‹Tools/mrbnf_fp.ML›

 

 
 
signature MRBNF_FP =
@@ -2377,6 +2377,35 @@ 
File ‹../Tools/mrbnf_fp.ML›

     val cctor_eq_intro_rrenames = map (fn thm => (thm RS iffD2)
       |> funpow fbound (fn thm => thm OF [exI]) OF [mk_conjIN (3*fbound + 1)]) TT_injects0;
 
+        fun mk_noclash_rename renames FVars_renames = @{map 4} (fn mrbnf => fn map_t => fn noclash => fn x =>
+      let
+        val goal = mk_Trueprop_eq (
+          fst noclash $ (comb_mrbnf_term ffs_ids (map (fn t => Term.list_comb (t, ffs)) renames) map_t $ x),
+          fst noclash $ x
+        );
+      in Goal.prove_sorry lthy (map (fst o dest_Free) (ffs @ [x])) prem_terms_ffs goal (fn {context=ctxt, prems} => EVERY1 [
+        K (Local_Defs.unfold0_tac ctxt [snd noclash]),
+        REPEAT_DETERM o EVERY' [
+          EqSubst.eqsubst_tac ctxt [0] (MRBNF_Def.set_map_of_mrbnf mrbnf),
+          REPEAT_DETERM o resolve_tac ctxt (@{thms supp_id_bound bij_id} @ prems)
+        ],
+        K (Local_Defs.unfold0_tac ctxt @{thms image_comp[unfolded comp_def]}),
+        REPEAT_DETERM o EVERY' [
+          EqSubst.eqsubst_tac ctxt [0] FVars_renames,
+          REPEAT_DETERM o resolve_tac ctxt prems
+        ],
+        K (Local_Defs.unfold0_tac ctxt @{thms image_Un[symmetric] image_UN[symmetric]}),
+        REPEAT_DETERM o EVERY' [
+          EqSubst.eqsubst_tac ctxt [0] @{thms image_Int[OF bij_is_inj, symmetric]},
+          resolve_tac ctxt prems
+        ],
+        K (Local_Defs.unfold0_tac ctxt @{thms image_is_empty}),
+        rtac ctxt refl
+      ]) end
+    ) mrbnfs;
+    val noclash_renames = mk_noclash_rename renamesAs (flat FVars_renamess) mrbnf_maps_AsAs noclashs xs;
+    val nnoclash_rrenames = mk_noclash_rename rrenamesAs (flat FFVars_rrenamess) mrbnf_maps_BsBs nnoclashs vs;
+
     (* TODO: use giant map instead of x times (nth ... i) *)
     val (raw_ress, quot_ress) = split_list (map (fn i =>
       let
@@ -2389,6 +2418,7 @@ 
File ‹../Tools/mrbnf_fp.ML›

           noclash = nth noclashs i,
 
           inject = nth raw_injects i,
+          noclash_rename = nth noclash_renames i,
           rename_id0 = nth rename_id0s i,
           rename_id = nth rename_ids i,
           rename_comp0 = nth rename_comp0s i,
@@ -2431,6 +2461,7 @@ 
File ‹../Tools/mrbnf_fp.ML›

           noclash = nth nnoclashs i,
 
           inject = nth TT_injects0 i,
+          noclash_rename = nth nnoclash_rrenames i,
           rename_id0 = nth rrename_id0s i,
           rename_id = nth rrename_ids i,
           rename_comp0 = nth rrename_comp0s i,
@@ -2505,6 +2536,8 @@ 
File ‹../Tools/mrbnf_fp.ML›

        ("alpha_avoids", alpha_avoids),
        ("equivp_alphas", equivp_alphas),
        ("nnoclash_noclashs", nnoclash_noclashs),
+       ("nnoclash_rrenames", nnoclash_rrenames),
+       ("noclash_renames", noclash_renames),
        ("TT_Quotients", TT_Quotients),
        ("TT_alpha_quotient_syms", alpha_quotient_syms),
        ("TT_Quotient_total_abs_eq_iffs", Quotient_total_abs_eq_iffs),
diff --git a/html/Binders/Tools/mrbnf_fp_def_sugar.ML.html b/html/Binders/Tools/mrbnf_fp_def_sugar.ML.html
index 72a47692..bbd550de 100644
--- a/html/Binders/Tools/mrbnf_fp_def_sugar.ML.html
+++ b/html/Binders/Tools/mrbnf_fp_def_sugar.ML.html
@@ -3,13 +3,13 @@
 
 
 
-File ‹../Tools/mrbnf_fp_def_sugar.ML›
+File ‹Tools/mrbnf_fp_def_sugar.ML›
 
 
 
 
 

-
File ‹../Tools/mrbnf_fp_def_sugar.ML›

+
File ‹Tools/mrbnf_fp_def_sugar.ML›

 

 
 
signature MRBNF_FP_DEF_SUGAR =
@@ -23,6 +23,7 @@ 
File ‹../Tools/mrbnf_fp_def_sugar.ML›

     inner: 'a,
 
     inject: thm,
+    noclash_rename: thm,
     rename_id0: thm,
     rename_id: thm,
     rename_comp0: thm,
@@ -114,6 +115,7 @@ 
File ‹../Tools/mrbnf_fp_def_sugar.ML›

   inner: 'a,
 
   inject: thm,
+  noclash_rename: thm,
   rename_id0: thm,
   rename_id: thm,
   rename_comp0: thm,
@@ -129,7 +131,7 @@ 
File ‹../Tools/mrbnf_fp_def_sugar.ML›

 
 fun morph_fp_result_T morph phi { T, ctor, rename, FVars, inner, inject, rename_id0, rename_id,
   rename_comp0, rename_comp, rename_bij, rename_inv_simp, FVars_ctors, FVars_renames, card_of_FVars_bounds,
-  card_of_FVars_bound_UNIVs, FVars_intross, noclash } = {
+  card_of_FVars_bound_UNIVs, FVars_intross, noclash, noclash_rename } = {
   T = Morphism.typ phi T,
   ctor = Morphism.term phi ctor,
   rename = Morphism.term phi rename,
@@ -137,6 +139,7 @@ 
File ‹../Tools/mrbnf_fp_def_sugar.ML›

   noclash = BNF_Util.map_prod (Morphism.term phi) (Morphism.thm phi) noclash,
   inner = morph phi inner,
   inject = Morphism.thm phi inject,
+  noclash_rename = Morphism.thm phi noclash_rename,
   rename_id0 = Morphism.thm phi rename_id0,
   rename_id = Morphism.thm phi rename_id,
   rename_comp0 = Morphism.thm phi rename_comp0,
diff --git a/html/Binders/Tools/mrbnf_fp_tactics.ML.html b/html/Binders/Tools/mrbnf_fp_tactics.ML.html
index be875aeb..87633b66 100644
--- a/html/Binders/Tools/mrbnf_fp_tactics.ML.html
+++ b/html/Binders/Tools/mrbnf_fp_tactics.ML.html
@@ -3,13 +3,13 @@
 
 
 
-File ‹../Tools/mrbnf_fp_tactics.ML›
+File ‹Tools/mrbnf_fp_tactics.ML›
 
 
 
 
 

-
File ‹../Tools/mrbnf_fp_tactics.ML›

+
File ‹Tools/mrbnf_fp_tactics.ML›

 

 
 
signature MRBNF_FP_TACTICS =
diff --git a/html/Binders/Tools/mrbnf_recursor.ML.html b/html/Binders/Tools/mrbnf_recursor.ML.html
index adde5f86..03f9029f 100644
--- a/html/Binders/Tools/mrbnf_recursor.ML.html
+++ b/html/Binders/Tools/mrbnf_recursor.ML.html
@@ -3,13 +3,13 @@
 
 
 
-File ‹../Tools/mrbnf_recursor.ML›
+File ‹Tools/mrbnf_recursor.ML›
 
 
 
 
 

-
File ‹../Tools/mrbnf_recursor.ML›

+
File ‹Tools/mrbnf_recursor.ML›

 

 
 
signature MRBNF_RECURSOR =
diff --git a/html/Binders/Tools/mrbnf_recursor_tactics.ML.html b/html/Binders/Tools/mrbnf_recursor_tactics.ML.html
index ee2146ed..e0ab4924 100644
--- a/html/Binders/Tools/mrbnf_recursor_tactics.ML.html
+++ b/html/Binders/Tools/mrbnf_recursor_tactics.ML.html
@@ -3,13 +3,13 @@
 
 
 
-File ‹../Tools/mrbnf_recursor_tactics.ML›
+File ‹Tools/mrbnf_recursor_tactics.ML›
 
 
 
 
 

-
File ‹../Tools/mrbnf_recursor_tactics.ML›

+
File ‹Tools/mrbnf_recursor_tactics.ML›

 

 
 
signature MRBNF_RECURSOR_TACTICS =
diff --git a/html/Binders/Tools/mrbnf_sugar.ML.html b/html/Binders/Tools/mrbnf_sugar.ML.html
index 833ce816..9945bf85 100644
--- a/html/Binders/Tools/mrbnf_sugar.ML.html
+++ b/html/Binders/Tools/mrbnf_sugar.ML.html
@@ -3,13 +3,13 @@
 
 
 
-File ‹../Tools/mrbnf_sugar.ML›
+File ‹Tools/mrbnf_sugar.ML›
 
 
 
 
 

-
File ‹../Tools/mrbnf_sugar.ML›

+
File ‹Tools/mrbnf_sugar.ML›

 

 
 
signature MRBNF_SUGAR =
@@ -28,8 +28,10 @@ 
File ‹../Tools/mrbnf_sugar.ML›

 type binder_sugar = {
   map_simps: thm list,
   set_simpss: thm list list,
+  permute_simps: thm list,
   subst_simps: thm list option,
   bsetss: term option list list,
+  permute_bounds: term option list list,
   bset_bounds: thm list,
   mrbnf: MRBNF_Def.mrbnf,
   strong_induct: thm,
@@ -69,8 +71,10 @@ 
File ‹../Tools/mrbnf_sugar.ML›

 type binder_sugar = {
   map_simps: thm list,
   set_simpss: thm list list,
+  permute_simps: thm list,
   subst_simps: thm list option,
   bsetss: term option list list,
+  permute_bounds: term option list list,
   bset_bounds: thm list,
   mrbnf: MRBNF_Def.mrbnf,
   strong_induct: thm,
@@ -78,12 +82,14 @@ 
File ‹../Tools/mrbnf_sugar.ML›

   ctors: (term * thm) list
 };
 
-fun morph_binder_sugar phi { map_simps, set_simpss, subst_simps, mrbnf,
-  strong_induct, distinct, ctors, bsetss, bset_bounds } = {
+fun morph_binder_sugar phi { map_simps, permute_simps, set_simpss, subst_simps, mrbnf,
+  strong_induct, distinct, ctors, bsetss, bset_bounds, permute_bounds } = {
   map_simps = map (Morphism.thm phi) map_simps,
+  permute_simps = map (Morphism.thm phi) permute_simps,
   set_simpss = map (map (Morphism.thm phi)) set_simpss,
   subst_simps = Option.map (map (Morphism.thm phi)) subst_simps,
   bsetss = map (map (Option.map (Morphism.term phi))) bsetss,
+  permute_bounds = map (map (Option.map (Morphism.term phi))) permute_bounds,
   bset_bounds = map (Morphism.thm phi) bset_bounds,
   mrbnf = MRBNF_Def.morph_mrbnf phi mrbnf,
   strong_induct = Morphism.thm phi strong_induct,
@@ -345,8 +351,7 @@ 
File ‹../Tools/mrbnf_sugar.ML›

     val bounds = map_filter (fn (x, MRBNF_Def.Bound_Var) => SOME (TFree x) | _ => NONE) (#vars spec);
     val frees = map_filter (fn (x, MRBNF_Def.Free_Var) => SOME (TFree x) | _ => NONE) (#vars spec);
 
-    (* TODO: Use mrbnf sets here (only relevant for passive variables) *)
-    val (bset_optss, set_simpss) = split_list (map (fn FVars =>
+    val param_vars = map (fn FVars =>
       let
         fun get_var vars = hd (filter (fn T =>
           Term.typ_subst_atomic replace T = HOLogic.dest_setT (range_type (fastype_of FVars))
@@ -356,7 +361,12 @@ 
File ‹../Tools/mrbnf_sugar.ML›

         val rec_bounds = map (nth rec_vars) (the_default [] (
           Option.mapPartial (try (nth (#binding_rel spec))) (get_index bound bounds)
         ));
-      in split_list (map2 (fn (ctor, _) => fn (_, tys) =>
+      in (free, bound, rec_bounds) end
+    ) (#FVars quotient);
+
+    (* TODO: Use mrbnf sets here (only relevant for passive variables) *)
+    val (bset_optss, set_simpss) = split_list (map2 (fn FVars => fn (free, bound, rec_bounds) =>
+      split_list (map2 (fn (ctor, _) => fn (_, tys) =>
         let
           val (xs, _) = lthy
             |> mk_Frees "x" tys;
@@ -417,9 +427,10 @@ 
File ‹../Tools/mrbnf_sugar.ML›

           ]
         ])) end
       ) ctors (#ctors spec))
-    end) (#FVars quotient));
+    ) (#FVars quotient) param_vars);
 
     val ctors_tys = ctors ~~ map snd (#ctors spec);
+
     val distinct = flat (flat (map_index (fn (i, ((ctor, ctor_def), tys1)) => map_index (fn (j, ((ctor2, ctor2_def), tys2)) =>
       let
         val ((xs, ys), _) = names_lthy
@@ -438,7 +449,7 @@ 
File ‹../Tools/mrbnf_sugar.ML›

       ])] end
     ) ctors_tys) ctors_tys));
 
-    (* TODO: map_bij (rename simps); injection *)
+    (* TODO: injection *)
 
     (* Term for variable substitution *)
     val x = length replace - #rec_vars spec;
@@ -519,10 +530,13 @@ 
File ‹../Tools/mrbnf_sugar.ML›

       UN_single
     };
     val nvars = length vars;
-    fun mk_map_simps lthy fs mk_supp_bound_opt mk_imsupp mapx tac =
+    fun mk_map_simps lthy do_noclash fs mk_supp_bound_opt mk_imsupp_opt mk_extra_prems extra_apply_args mapx tac =
       let
         val mapx = Term.list_comb (mapx, fs);
-        val prems = map_filter (Option.map HOLogic.mk_Trueprop o mk_supp_bound_opt) fs;
+        val (prem_fs, prems) = split_list (map_filter (fn f => case mk_supp_bound_opt f of
+          NONE => NONE
+          | SOME t => SOME (f, HOLogic.mk_Trueprop t)
+        ) fs);
 
         fun mk_map (T as Type (n, Ts)) = (case MRBNF_Def.mrbnf_of lthy n of
               SOME mrbnf =>
@@ -538,7 +552,7 @@ 
File ‹../Tools/mrbnf_sugar.ML›

                 else Term.list_comb (inner_map, gs) end
               | NONE => HOLogic.id_const T)
             | mk_map (T as TFree _) =
-              (if member (op=) frees T then
+              (if member (op=) (frees @ extra_apply_args) T then
                 case List.find (fn Free (_, T') => domain_type T' = Term.typ_subst_atomic replace T) fs of
                   SOME t => t
                   | NONE => HOLogic.id_const T
@@ -590,16 +604,19 @@ 
File ‹../Tools/mrbnf_sugar.ML›

               | NONE => replicate nvars NONE
             in map2 (fn b => fn FVars => map_filter I (map2 (mk_set (b::recs) FVars) tys xs)) vars FVars end;
           val bound_sets = mk_sets bounds [] NONE;
-          fun get_fs T = filter (fn t' => HOLogic.dest_setT (fastype_of (mk_imsupp t' T)) = T) fs;
+          fun get_fs T = filter (fn t' => case mk_imsupp_opt t' T of
+            NONE => false
+            | SOME t => HOLogic.dest_setT (fastype_of t) = T
+          ) fs;
           val imsupp_prems = maps (map_filter (fn t => case Term.subst_atomic_types replace t of
               (Const (@{const_name Set.insert}, _) $ (t as Free (_, T)) $ _) => (case get_fs T of
                 [] => NONE
-                | xs => SOME (HOLogic.mk_Trueprop (HOLogic.mk_not (HOLogic.mk_mem (t, foldl1 mk_Un (map (fn f => mk_imsupp f T) xs))))))
+                | xs => SOME (HOLogic.mk_Trueprop (HOLogic.mk_not (HOLogic.mk_mem (t, foldl1 mk_Un (map (fn f => the (mk_imsupp_opt f T)) xs))))))
               | t =>
                 let val T = HOLogic.dest_setT (fastype_of t);
                 in case get_fs T of
                   [] => NONE
-                  | xs => SOME (HOLogic.mk_Trueprop (mk_int_empty (t, foldl1 mk_Un (map (fn f => mk_imsupp f T) xs))))
+                  | xs => SOME (HOLogic.mk_Trueprop (mk_int_empty (t, foldl1 mk_Un (map (fn f => the (mk_imsupp_opt f T)) xs))))
                 end
           )) bound_sets;
 
@@ -608,14 +625,16 @@ 
File ‹../Tools/mrbnf_sugar.ML›

           val free_rec_vars = subtract (op=) (map (nth rec_vars) (flat (#binding_rel spec))) rec_vars;
           val free_sets = collect_sets (mk_sets frees free_rec_vars (SOME (#FVars quotient)));
 
-          val noclash_prems = map_filter (Option.map HOLogic.mk_Trueprop) (map2 (fn a => fn b => case (a, b) of
-            (SOME (Const (@{const_name Set.insert}, _) $ x $ _), SOME (Const (@{const_name Set.insert}, _) $ y $ _)) =>
-              SOME (HOLogic.mk_not (HOLogic.mk_eq (x, y)))
-            | (SOME (Const (@{const_name Set.insert}, _) $ x $ _), SOME ys) => SOME (HOLogic.mk_not (HOLogic.mk_mem (x, ys)))
-            | (SOME xs, SOME (Const (@{const_name Set.insert}, _) $ y $ _)) => SOME (HOLogic.mk_not (HOLogic.mk_mem (y, xs)))
-            | (SOME free, SOME bound) => SOME (mk_int_empty (free, bound))
-            | _ => NONE
-          ) bound_sets' free_sets);
+          val noclash_prems = if do_noclash then
+            map_filter (Option.map HOLogic.mk_Trueprop) (map2 (fn a => fn b => case (a, b) of
+              (SOME (Const (@{const_name Set.insert}, _) $ x $ _), SOME (Const (@{const_name Set.insert}, _) $ y $ _)) =>
+                SOME (HOLogic.mk_not (HOLogic.mk_eq (x, y)))
+              | (SOME (Const (@{const_name Set.insert}, _) $ x $ _), SOME ys) => SOME (HOLogic.mk_not (HOLogic.mk_mem (x, ys)))
+              | (SOME xs, SOME (Const (@{const_name Set.insert}, _) $ y $ _)) => SOME (HOLogic.mk_not (HOLogic.mk_mem (y, xs)))
+              | (SOME free, SOME bound) => SOME (mk_int_empty (free, bound))
+              | _ => NONE
+            ) bound_sets' free_sets)
+          else [];
 
           val rhs = if length ts = 1 andalso member (op=) frees (hd tys)
             andalso fastype_of (hd ts) = range_type (fastype_of quotient_ctor)
@@ -623,7 +642,7 @@ 
File ‹../Tools/mrbnf_sugar.ML›

           val goal = mk_Trueprop_eq (
             mapx $ Term.list_comb (ctor, xs), rhs
           );
-        in Goal.prove_sorry lthy (names (fs @ xs)) (prems @ imsupp_prems @ noclash_prems) goal (fn {context=ctxt, prems} =>
+        in Goal.prove_sorry lthy (names (fs @ xs)) (flat (map2 (fn p => fn f => mk_extra_prems f @ [p]) prems prem_fs) @ imsupp_prems @ noclash_prems) goal (fn {context=ctxt, prems} =>
           Local_Defs.unfold0_tac ctxt [ctor_def] THEN tac ctxt prems
         ) end
       ) ctors (#ctors spec) end;
@@ -654,7 +673,48 @@ 
File ‹../Tools/mrbnf_sugar.ML›

           K (Local_Defs.unfold0_tac ctxt @{thms id_def}),
           rtac ctxt refl
         ];
-      in mk_map_simps lthy fs (SOME o MRBNF_Recursor.mk_supp_bound) (fn t => fn _ => mk_imsupp t) mapx tac end;
+      in mk_map_simps lthy true fs (SOME o MRBNF_Recursor.mk_supp_bound) (fn t => fn _ => SOME (mk_imsupp t)) (K []) [] mapx tac end;
+
+    val (fs, _) = lthy
+        |> mk_Frees "f" (map (fn a => a --> a) vars);
+    val permute_simps =
+      let
+        val Ts' = snd (dest_Type qT);
+        val mapx = Term.subst_atomic_types (Ts' ~~ vars) (#rename quotient);
+        fun tac ctxt prems = EVERY1 [
+          rtac ctxt (trans OF [#rename_ctor (#inner quotient)]),
+          K (Local_Defs.unfold0_tac ctxt (thms @ MRBNF_Def.set_defs_of_mrbnf pre_mrbnf @ [
+            MRBNF_Def.map_def_of_mrbnf pre_mrbnf,
+            #Abs_inverse (snd info) OF @{thms UNIV_I}
+          ])),
+          REPEAT_DETERM o resolve_tac ctxt prems,
+          K (Local_Defs.unfold0_tac ctxt @{thms id_apply}),
+          rtac ctxt refl
+        ];
+      in mk_map_simps lthy false fs (SOME o MRBNF_Recursor.mk_supp_bound) (K (K NONE))
+        (single o HOLogic.mk_Trueprop o mk_bij) bounds mapx tac
+      end;
+
+    val permute_boundss = map2 (fn (_, tys) => fn permute_simp =>
+      let
+        val (xs, _) = lthy
+          |> mk_Frees "x" (map (Term.typ_subst_atomic replace) tys);
+        val permute_args = Thm.prop_of permute_simp
+          |> Logic.strip_imp_concl
+          |> HOLogic.dest_Trueprop
+          |> snd o HOLogic.dest_eq
+          |> Logic.unvarify_global
+          |> snd o Term.strip_comb;
+
+        val bound = map (fn T =>
+          map (fn (_, bound, rec_bounds) => member (op=) (bound::rec_bounds) T) param_vars
+        ) tys;
+      in @{map 3} (fn x => fn t => fn bn => if not (exists I bn) then NONE else SOME (
+         fold_rev (fn (b, f) => fn t => Term.absfree (dest_Free f) (if b then t else
+           Term.subst_atomic [(f, HOLogic.id_const (domain_type (fastype_of f)))] t
+         )) (bn ~~ fs) (Term.absfree (dest_Free x) t)
+      )) xs permute_args bound end
+    ) ctors_tys permute_simps;
 
     val cmin_UNIV = foldl1 mk_cmin (map (mk_card_of o HOLogic.mk_UNIV) vars);
     val Cinfinite_card = Goal.prove_sorry lthy [] [] (HOLogic.mk_Trueprop (HOLogic.mk_conj (
@@ -676,12 +736,12 @@ 
File ‹../Tools/mrbnf_sugar.ML›

               domain_type (domain_type (fastype_of s)) = domain_type (fastype_of h)
             ) (#SSupps tvsubst_res));
             fun mk_supp_bound h = Option.map (fn s => mk_ordLess (mk_card_of s) cmin_UNIV) (mk_supp h);
-            fun mk_imsupp h T = foldl1 mk_Un (map_filter (fn f => Option.map (fn t => t $ f) (
+            fun mk_imsupp h T = SOME (foldl1 mk_Un (map_filter (fn f => Option.map (fn t => t $ f) (
               List.find (fn s => domain_type (fastype_of s) = fastype_of h
                 andalso domain_type (fastype_of s) = fastype_of f
                 andalso HOLogic.dest_setT (range_type (fastype_of s)) = T
               ) (flat (#IImsuppss tvsubst_res))
-            )) fs);
+            )) fs));
             fun tac ctxt prems = EVERY1 [
               K (Local_Defs.unfold0_tac ctxt (map (Thm.symmetric o snd) (#VVrs tvsubst_res))),
               EVERY' [
@@ -720,7 +780,7 @@ 
File ‹../Tools/mrbnf_sugar.ML›

                 rtac ctxt refl
               ]
             ];
-          in mk_map_simps lthy fs mk_supp_bound mk_imsupp (#tvsubst tvsubst_res) tac end;
+          in mk_map_simps lthy true fs mk_supp_bound mk_imsupp (K []) [] (#tvsubst tvsubst_res) tac end;
         in (lthy, SOME (tvsubst_res, tvsubst_simps)) end
       else (lthy, NONE);
 
@@ -730,9 +790,11 @@ 
File ‹../Tools/mrbnf_sugar.ML›

     val sugar = {
       map_simps = map_simps,
       set_simpss = set_simpss,
+      permute_simps = permute_simps,
       strong_induct = strong_induct,
       subst_simps = Option.map snd tvsubst_opt,
       bsetss = bset_optss,
+      permute_bounds = permute_boundss,
       bset_bounds = [],
       mrbnf = mrbnf,
       distinct = distinct,
@@ -747,6 +809,7 @@ 
File ‹../Tools/mrbnf_sugar.ML›

         ("induct", [induct], [induct_attrib]),
         ("set", flat set_simpss, simp),
         ("map", map_simps, simp),
+        ("permute", permute_simps, simp),
         ("distinct", distinct, simp)
       ] @ the_default [] (Option.map (fn (_, tvsubst_simps) => [("subst", tvsubst_simps, simp)]) tvsubst_opt)
       ) |> (map (fn (thmN, thms, attrs) =>
diff --git a/html/Binders/Tools/mrbnf_tvsubst.ML.html b/html/Binders/Tools/mrbnf_tvsubst.ML.html
index 685c376d..9f144a87 100644
--- a/html/Binders/Tools/mrbnf_tvsubst.ML.html
+++ b/html/Binders/Tools/mrbnf_tvsubst.ML.html
@@ -3,13 +3,13 @@
 
 
 
-File ‹../Tools/mrbnf_tvsubst.ML›
+File ‹Tools/mrbnf_tvsubst.ML›
 
 
 
 
 

-
File ‹../Tools/mrbnf_tvsubst.ML›

+
File ‹Tools/mrbnf_tvsubst.ML›

 

 
 
signature MRBNF_TVSUBST =
@@ -1491,6 +1491,159 @@ 
File ‹../Tools/mrbnf_tvsubst.ML›

       )) (#FVars quotient) hs (0 upto nvars - 1) in_IImsuppss
     ) (#quotient_fps fp_res) in_IImsuppsss hss defss;
 
+    val IImsupp_naturalsss = @{map 3} (fn quotient => @{map 3} (fn f => fn SSupp_natural => Option.map (fn def => map2 (fn f' => fn IImsupp =>
+      let
+        val g = Free ("g", #aT def --> #T quotient);
+        val goal = mk_Trueprop_eq (
+          fst IImsupp $ HOLogic.mk_comp (
+            HOLogic.mk_comp (Term.list_comb (#rename quotient, fs), g),
+            mk_inv f
+          ),
+          mk_image f' $ (fst IImsupp $ g)
+        );
+      in Goal.prove_sorry lthy (names (fs @ [g])) f_prems goal (fn {context=ctxt, prems} => EVERY1 [
+        K (unfold_thms_tac ctxt (@{thms image_Un image_UN} @ [snd IImsupp])),
+        TRY o (rtac ctxt @{thm arg_cong2[of _ _ _ _ "(∪)"]} THEN' rtac ctxt (the SSupp_natural OF prems)),
+        EqSubst.eqsubst_tac ctxt [0] [the SSupp_natural OF prems],
+        K (Local_Defs.unfold0_tac ctxt @{thms image_comp comp_assoc}),
+        EqSubst.eqsubst_tac ctxt [0] @{thms inv_o_simp1},
+        resolve_tac ctxt prems,
+        K (Local_Defs.unfold0_tac ctxt @{thms o_id}),
+        K (Local_Defs.unfold0_tac ctxt @{thms comp_def}),
+        EqSubst.eqsubst_tac ctxt [0] (maps #FVars_renames (#quotient_fps fp_res)),
+        REPEAT_DETERM o resolve_tac ctxt (refl :: prems)
+      ]) end
+    ) fs (#IImsupps def))) fs) (#quotient_fps fp_res) SSupp_naturalss defss;
+
+    fun SELECT_GOALS n tac i st =
+      if Thm.nprems_of st = 1 andalso i = 1 then tac st
+      else (PRIMITIVE (Goal.restrict i n) THEN tac THEN PRIMITIVE (Goal.unrestrict i)) st;
+
+    val tvsubst_rrenames =
+      let
+        val (ts, _) = lthy
+          |> mk_Frees "t" (map #T (#quotient_fps fp_res));
+        fun mk_goals comb = @{map 3} (fn quotient => fn tvsubst => fn t =>
+          let
+            val hs' = map_filter I (maps (map2 (fn f => Option.map (fn h => HOLogic.mk_comp (
+              HOLogic.mk_comp (Term.list_comb (#rename quotient, fs), h),
+              mk_inv f
+            ))) fs) hss);
+          in HOLogic.mk_eq (
+            comb (Term.list_comb (#rename quotient, fs)) (Term.list_comb (fst tvsubst, some_hs)) t,
+            comb (Term.list_comb (fst tvsubst, hs')) (Term.list_comb (#rename quotient, fs)) t
+          ) end
+        ) (#quotient_fps fp_res) tvsubsts ts;
+        val As = map (fn i =>
+          foldl1 mk_Un (map2 (fn f => fn def =>
+            fst (nth (#IImsupps def) i) $ f
+          ) some_hs some_defs)
+        ) (0 upto nvars - 1);
+
+        val goal = HOLogic.mk_Trueprop (foldr1 HOLogic.mk_conj (
+          mk_goals (fn t1 => fn t2 => fn t => t1 $ (t2 $ t))
+        ));
+        val thms = split_conj (length mrbnfs) (Goal.prove_sorry lthy (names (fs @ some_hs @ ts)) (f_prems @ f'_prems) goal (fn {context=ctxt, prems} =>
+          let val (f_prems, f'_prems) = chop (length f_prems) prems;
+          in EVERY1 [
+            rtac ctxt (infer_instantiate' ctxt (
+              map (SOME o Thm.cterm_of ctxt) As @ replicate (length mrbnfs) NONE @ map (SOME o Thm.cterm_of ctxt) ts
+            ) (#fresh_co_induct (#inner (hd (#quotient_fps fp_res))))),
+            SELECT_GOALS (length As) (EVERY1 [
+              K (Local_Defs.unfold0_tac ctxt (@{thm comp_def} :: maps (map snd o #IImsupps) some_defs)),
+              REPEAT_DETERM o resolve_tac ctxt (
+                @{thms ordLeq_refl cmin1 cmin2 card_of_Card_order}
+                @ map (fn thm => @{thm ordLess_ordLeq_trans} OF [thm]) f'_prems
+                @ maps (fn mrbnf => [
+                  MRBNF_Def.Un_bound_of_mrbnf mrbnf, MRBNF_Def.UNION_bound_of_mrbnf mrbnf
+                ]) mrbnfs
+                @ maps #card_of_FVars_bound_UNIVs (#quotient_fps fp_res)
+              )
+            ]),
+            EVERY' (@{map 9} (fn mrbnf => fn quotient => fn defs => fn tvsubst_not_isVVr => fn isVVr_renames => fn SSupp_naturals => fn IImsupp_naturalss => fn rrename_VVrs => fn tvsubst_VVrs =>
+              let val n = length (map_filter I defs);
+              in Subgoal.FOCUS_PREMS (fn {context=ctxt, prems=IHs, ...} => EVERY1 [
+                REPEAT_DETERM_N n o rtac ctxt @{thm case_split[rotated]},
+                EqSubst.eqsubst_tac ctxt [0] [#rename_ctor (#inner quotient) OF f_prems],
+                EqSubst.eqsubst_tac ctxt [0] [Drule.rotate_prems (~1 - n) tvsubst_not_isVVr],
+                resolve_tac ctxt IHs,
+                REPEAT_DETERM o assume_tac ctxt,
+                REPEAT_DETERM o resolve_tac ctxt f'_prems,
+                REPEAT_DETERM o (rtac ctxt @{thm disjointI} THEN' eresolve_tac ctxt IHs),
+                EqSubst.eqsubst_tac ctxt [0] [Drule.rotate_prems (~1 - n) tvsubst_not_isVVr],
+                rtac ctxt (iffD2 OF [#noclash_rename quotient OF f_prems]),
+                resolve_tac ctxt IHs,
+                REPEAT_DETERM o EVERY' [
+                  EqSubst.eqsubst_tac ctxt [0] [#rename_ctor (#inner quotient) RS sym OF f_prems],
+                  EqSubst.eqsubst_tac ctxt [0] (map_filter (Option.map (fn thm => thm OF f_prems)) isVVr_renames),
+                  assume_tac ctxt
+                ],
+                REPEAT_DETERM o EVERY' [
+                  EqSubst.eqsubst_tac ctxt [0] (map_filter (Option.map (fn thm => thm OF f_prems)) SSupp_naturals),
+                  rtac ctxt @{thm ordLeq_ordLess_trans[OF card_of_image]},
+                  resolve_tac ctxt f'_prems
+                ],
+                REPEAT_DETERM o EVERY' [
+                  REPEAT_DETERM1 o EVERY' [
+                    EqSubst.eqsubst_tac ctxt [0] (MRBNF_Def.set_map_of_mrbnf mrbnf @ flat (map_filter I IImsupp_naturalss)),
+                    REPEAT_DETERM o resolve_tac ctxt (@{thms supp_id_bound bij_id} @ f_prems)
+                  ],
+                  K (Local_Defs.unfold0_tac ctxt @{thms image_Un[symmetric]}),
+                  rtac ctxt @{thm trans[OF image_Int[OF bij_is_inj, symmetric]]},
+                  resolve_tac ctxt f_prems,
+                  rtac ctxt @{thm iffD2[OF image_is_empty]},
+                  rtac ctxt @{thm disjointI},
+                  eresolve_tac ctxt IHs
+                ],
+                rtac ctxt (trans OF [#rename_ctor (#inner quotient) OF f_prems]),
+                rtac ctxt (mk_arg_cong lthy 1 (#ctor quotient)),
+                rtac ctxt (trans OF [MRBNF_Def.map_comp_of_mrbnf mrbnf]),
+                REPEAT_DETERM o resolve_tac ctxt (@{thms supp_id_bound bij_id} @ f_prems),
+                rtac ctxt sym,
+                rtac ctxt (trans OF [MRBNF_Def.map_comp_of_mrbnf mrbnf]),
+                REPEAT_DETERM o resolve_tac ctxt (@{thms supp_id_bound bij_id} @ f_prems),
+                K (Local_Defs.unfold0_tac ctxt @{thms id_o o_id}),
+                rtac ctxt (MRBNF_Def.map_cong0_of_mrbnf mrbnf),
+                REPEAT_DETERM o resolve_tac ctxt (@{thms supp_id_bound bij_id refl} @ f_prems),
+                REPEAT_DETERM o EVERY' [
+                  rtac ctxt @{thm trans[OF comp_apply]},
+                  rtac ctxt sym,
+                  rtac ctxt @{thm trans[OF comp_apply]},
+                  eresolve_tac ctxt IHs
+                ],
+                EVERY' (map_filter (Option.map (fn def => EVERY' [
+                  K (Local_Defs.unfold0_tac ctxt [snd (#isVVr def)]),
+                  etac ctxt exE,
+                  etac ctxt @{thm subst[OF sym]},
+                  EqSubst.eqsubst_tac ctxt [0] (map_filter I rrename_VVrs),
+                  REPEAT_DETERM o resolve_tac ctxt f_prems,
+                  EqSubst.eqsubst_tac ctxt [0] (map_filter I tvsubst_VVrs),
+                  REPEAT_DETERM o resolve_tac ctxt f'_prems,
+                  EqSubst.eqsubst_tac ctxt [0] (map_filter I tvsubst_VVrs),
+                  REPEAT_DETERM o EVERY' [
+                    EqSubst.eqsubst_tac ctxt [0] (map_filter (Option.map (fn thm => thm OF f_prems)) SSupp_naturals),
+                    rtac ctxt @{thm ordLeq_ordLess_trans[OF card_of_image]},
+                    resolve_tac ctxt f'_prems
+                  ],
+                  K (Local_Defs.unfold0_tac ctxt @{thms comp_def}),
+                  EqSubst.eqsubst_tac ctxt [0] @{thms inv_simp1},
+                  resolve_tac ctxt f_prems,
+                  rtac ctxt refl
+                ])) (rev defs))
+              ]) ctxt end
+            ) mrbnfs (#quotient_fps fp_res) defss tvsubst_not_isVVrs isVVr_renamess SSupp_naturalss IImsupp_naturalsss rrename_VVrss tvsubst_VVrss)
+          ] end
+        ));
+
+        val goals = map HOLogic.mk_Trueprop (mk_goals (fn t1 => fn t2 => fn _ => HOLogic.mk_comp (t1, t2)));
+      in map2 (fn thm => fn goal => Goal.prove_sorry lthy (names (fs @ some_hs)) (f_prems @ f'_prems) goal (fn {context=ctxt, prems} => EVERY1 [
+        rtac ctxt ext,
+        rtac ctxt @{thm trans[OF comp_apply]},
+        rtac ctxt sym,
+        rtac ctxt @{thm trans[OF comp_apply]},
+        rtac ctxt (thm RS sym OF prems)
+      ])) thms goals end;
+
     (*val FFVars_tvsubsts = @{map 8} (fn FVars => fn i => fn f => fn tvsubst_VVr => fn FVars_VVr => fn not_isVVr_free => fn IImsupp_Diff => Option.map (fn def =>
       let
         val t = Free ("t", #T quotient);
@@ -1597,12 +1750,19 @@ 
File ‹../Tools/mrbnf_tvsubst.ML›

       [("SSupp_VVr_empty", maps (map_filter I) SSupp_VVr_emptiess),
        ("SSupp_VVr_bound", maps (map_filter I) SSupp_VVr_boundss),
        ("in_IImsupp", flat (maps (map_filter I) in_IImsuppsss)),
+       ("is_VVr_rrename", maps (map_filter I) isVVr_renamess),
+       ("rrename_VVr", maps (map_filter I) rrename_VVrss),
+       ("SSupp_natural", maps (map_filter I) SSupp_naturalss),
+       ("SSupp_comp_rename_bound", maps (map_filter (Option.map #SSupp_comp_rename_bound)) SSupp_compss),
+       ("SSupp_comp_bound", maps (map_filter (Option.map #SSupp_comp_bound)) SSupp_compss),
        ("eta_set_empties", flat (maps (map_filter I) eta_set_emptiess)),
        ("FVars_VVr", flat (maps (map_filter I) FVars_VVrss)),
        ("tvsubst_VVr", maps (map_filter I) tvsubst_VVrss),
        ("tvsubst_cctor_not_isVVr", tvsubst_not_isVVrs),
+       ("rrename_tvsubst", tvsubst_rrenames),
        ("not_isVVr_free", maps (map_filter I) not_isVVr_freess),
-       ("IImsupp_Diff", maps (map_filter I) IImsupp_Diffss)
+       ("IImsupp_Diff", maps (map_filter I) IImsupp_Diffss),
+       ("IImsupp_natural", flat (maps (map_filter I) IImsupp_naturalsss))
        (*("FFVars_tvsubst", map_filter I FFVars_tvsubsts)*)
       ] |> (map (fn (thmN, thms) =>
         ((Binding.qualify true (short_type_name (fst (dest_Type (#T (hd (#quotient_fps fp_res))))))
diff --git a/html/Binders/Tools/mrbnf_util.ML.html b/html/Binders/Tools/mrbnf_util.ML.html
index 545cd953..9d3e2c8f 100644
--- a/html/Binders/Tools/mrbnf_util.ML.html
+++ b/html/Binders/Tools/mrbnf_util.ML.html
@@ -3,13 +3,13 @@
 
 
 
-File ‹../Tools/mrbnf_util.ML›
+File ‹Tools/mrbnf_util.ML›
 
 
 
 
 

-
File ‹../Tools/mrbnf_util.ML›

+
File ‹Tools/mrbnf_util.ML›

 

 
 
signature MRBNF_UTIL =
diff --git a/html/Binders/Tools/mrbnf_vvsubst.ML.html b/html/Binders/Tools/mrbnf_vvsubst.ML.html
index 926c6b46..42e3948a 100644
--- a/html/Binders/Tools/mrbnf_vvsubst.ML.html
+++ b/html/Binders/Tools/mrbnf_vvsubst.ML.html
@@ -3,13 +3,13 @@
 
 
 
-File ‹../Tools/mrbnf_vvsubst.ML›
+File ‹Tools/mrbnf_vvsubst.ML›
 
 
 
 
 

-
File ‹../Tools/mrbnf_vvsubst.ML›

+
File ‹Tools/mrbnf_vvsubst.ML›

 

 
 
signature MRBNF_VVSUBST =
diff --git a/html/Binders/Tools/parser.ML.html b/html/Binders/Tools/parser.ML.html
index c1839865..46562bbe 100644
--- a/html/Binders/Tools/parser.ML.html
+++ b/html/Binders/Tools/parser.ML.html
@@ -3,13 +3,13 @@
 
 
 
-File ‹../Tools/parser.ML›
+File ‹Tools/parser.ML›
 
 
 
 
 

-
File ‹../Tools/parser.ML›

+
File ‹Tools/parser.ML›

 

 
 
signature BINDER_DATATYPE_PARSER =
diff --git a/html/Binders/Urban_Berghofer_Norrish_Rule_Induction.html b/html/Binders/Urban_Berghofer_Norrish_Rule_Induction.html
index 79a50e01..205499d0 100644
--- a/html/Binders/Urban_Berghofer_Norrish_Rule_Induction.html
+++ b/html/Binders/Urban_Berghofer_Norrish_Rule_Induction.html
@@ -282,6 +282,8 @@ 
Theory Urban_Berghofer_Norrish_Rule_Induction

 
 
 
+
+
 end

 
 
diff --git a/html/Binders/index.html b/html/Binders/index.html
index 1313cf67..f2534865 100644
--- a/html/Binders/index.html
+++ b/html/Binders/index.html
@@ -20,47 +20,47 @@ 
Theories

 

 
diff --git a/html/System_Fsub/SystemFSub.html b/html/System_Fsub/SystemFSub.html
index e926db39..303b6353 100644
--- a/html/System_Fsub/SystemFSub.html
+++ b/html/System_Fsub/SystemFSub.html
@@ -12,55 +12,58 @@
 
Theory SystemFSub

 
 
-
(* System F with SubTypeing  *)
+
(* System F with SubsftypePing  *)
 theory SystemFSub
   imports "SystemFSub_Types"
 begin
 
-abbreviation in_context :: "var ⇒ type ⇒ Γτ ⇒ bool" ("_ <: _ ∈ _" [55,55,55] 60) where
+
+abbreviation in_context :: "var ⇒ sftype ⇒ Γτ ⇒ bool" ("_ <: _ ∈ _" [55,55,55] 60) where
   "x <: t ∈ Γ ≡ (x, t) ∈ set Γ"
-abbreviation well_scoped :: "type ⇒ Γτ ⇒ bool" ("_ closed'_in _" [55, 55] 60) where
-  "well_scoped S Γ ≡ FFVars_Type S ⊆ dom Γ"
+
+abbreviation well_scoped :: "sftype ⇒ Γτ ⇒ bool" ("_ closed'_in _" [55, 55] 60) where
+  "well_scoped S Γ ≡ FFVars_sftypeP S ⊆ dom Γ"
+
 
 inductive wf :: "Γτ ⇒ bool"  where
   wf_Nil[intro]: "wf []"
-| wf_Cons[intro!]: "⟦ x ∉ dom Γ ; T closed_in Γ ; wf Γ⟧ ⟹ wf (Γ,,x<:T)"
+| wf_Cons[intro!]: "⟦ x ∉ dom Γ ; FFVars_sftypeP T ⊆ dom Γ ; wf Γ⟧ ⟹ wf (Γ,,x<:T)"
 
 inductive_cases
   wfE[elim]: "wf Γ"
   and wf_ConsE[elim!]: "wf (a#Γ)"
 print_theorems
 
-lemma in_context_eqvt:
+lemma in_context_eqvt[equiv]:
   assumes "bij f" "|supp f| <o |UNIV::var set|"
-  shows "x <: T ∈ Γ ⟹ f x <: rrename_Type f T ∈ map_context f Γ"
-  using assms unfolding map_context_def by auto
+  shows "x <: T ∈ Γ ⟹ f x <: rrename_sftypeP f T ∈ map_context f Γ"
+  using assms by auto
 
-lemma extend_eqvt:
+lemma extend_eqvt[equiv_commute]:
   assumes "bij f" "|supp f| <o |UNIV::var set|"
-  shows "map_context f (Γ,,x<:T) = map_context f Γ,,f x <: rrename_Type f T"
-  using assms unfolding map_context_def by simp
+  shows "map_context f (Γ,,x<:T) = map_context f Γ,,f x <: rrename_sftypeP f T"
+  using assms by simp
 
-lemma closed_in_eqvt:
+lemma closed_in_eqvt[equiv]:
   assumes "bij f" "|supp f| <o |UNIV::var set|"
-  shows "S closed_in Γ ⟹ rrename_Type f S closed_in map_context f Γ"
-  using assms by (auto simp: Type.FFVars_rrenames)
+  shows "FFVars_sftypeP S ⊆ dom Γ ⟹ FFVars_sftypeP (rrename_sftypeP f S) ⊆ dom (map_context f Γ)"
+  using assms context_dom_set by (auto simp: sftypeP.FFVars_rrenames)
 
-lemma wf_eqvt:
+lemma wf_eqvt[equiv]:
   assumes "bij f" "|supp f| <o |UNIV::var set|"
   shows "wf Γ ⟹ wf (map_context f Γ)"
-unfolding map_context_def proof (induction Γ)
+proof (induction Γ)
   case (Cons a Γ)
-  then show ?case using assms apply auto
+  then show ?case using assms apply auto
     apply (metis fst_conv image_iff)
-    using closed_in_eqvt map_context_def by fastforce
+    using closed_in_eqvt by fastforce
 qed simp
 
-abbreviation Tsupp :: "Γτ ⇒ type ⇒ type ⇒ var set" where
-  "Tsupp Γ T1 T2 ≡ dom Γ ∪ FFVars_ctxt Γ ∪ FFVars_Type T1 ∪ FFVars_Type T2"
+abbreviation Tsupp :: "Γτ ⇒ sftype ⇒ sftype ⇒ var set" where
+  "Tsupp Γ T1 T2 ≡ dom Γ ∪ FFVars_ctxt Γ ∪ FFVars_sftypeP T1 ∪ FFVars_sftypeP T2"
 
 lemma small_Tsupp: "small (Tsupp Γ T1 T2)"
-  by (auto simp: small_def Type.card_of_FFVars_bounds Type.Un_bound var_Type_pre_class.UN_bound set_bd_UNIV Type.set_bd)
+  by (auto simp: small_def sftypeP.card_of_FFVars_bounds sftypeP.Un_bound var_sftypeP_pre_class.UN_bound set_bd_UNIV sftypeP.set_bd)
 
 lemma fresh: "∃xx. xx ∉ Tsupp Γ T1 T2"
   by (metis emp_bound equals0D imageI inf.commute inf_absorb2 small_Tsupp small_def small_isPerm subsetI)
@@ -87,17 +90,17 @@ 
Theory SystemFSub

 
 (* *)
 
-inductive ty :: "Γτ ⇒ type ⇒ type ⇒ bool" ("_ ⊢ _ <: _" [55,55,55] 60) where
-  SA_Top: "⟦wf Γ; S closed_in Γ ⟧ ⟹ Γ ⊢ S <: Top"
-| SA_Refl_TVar: "⟦wf Γ; TyVar x closed_in Γ ⟧ ⟹ Γ ⊢ TyVar x <: TyVar x"
-| SA_Trans_TVar: "⟦ X<:U ∈ Γ ; Γ ⊢ U <: T ⟧ ⟹ Γ ⊢ TyVar X <: T"
+inductive ty :: "Γτ ⇒ sftype ⇒ sftype ⇒ bool" ("_ ⊢ _ <: _" [55,55,55] 60) where
+  SA_Top: "⟦wf Γ; FFVars_sftypeP S ⊆ dom Γ ⟧ ⟹ Γ ⊢ S <: Top"
+| SA_Refl_TVar: "⟦wf Γ;  FFVars_sftypeP  (TVr x) ⊆ dom Γ ⟧ ⟹ Γ ⊢ TVr x <: TVr x"
+| SA_Trans_TVar: "⟦ X<:U ∈ Γ ; Γ ⊢ U <: T ⟧ ⟹ Γ ⊢ TVr X <: T"
 | SA_Arrow: "⟦ Γ ⊢ T1 <: S1 ; Γ ⊢ S2 <: T2 ⟧ ⟹ Γ ⊢ S1 → S2 <: T1 → T2"
 | SA_All: "⟦ Γ ⊢ T1 <: S1 ; Γ,, X<:T1 ⊢ S2 <: T2 ⟧ ⟹ Γ ⊢ ∀X<:S1. S2 <: ∀X<:T1 .T2"
 
 inductive_cases
   SA_TopE[elim!]: "Γ ⊢ Top <: T"
 and
-  SA_TVarE: "Γ ⊢ S <: TyVar Z"
+  SA_TVarE: "Γ ⊢ S <: TVr Z"
 and
   SA_ArrER: "Γ ⊢ S <: T1 → T2"
 and
@@ -107,42 +110,23 @@ 
Theory SystemFSub

 and
   SA_AllEL: "Γ ⊢ ∀Z<:S1. S2 <: T "
 
+
 lemma wf_context: "Γ ⊢ S <: T ⟹ wf Γ"
   by (induction Γ S T rule: ty.induct)
 
-lemma well_scoped:
-  assumes "Γ ⊢ S <: T"
-  shows "S closed_in Γ" "T closed_in Γ"
-using assms proof (induction Γ S T rule: ty.induct)
-case (SA_Trans_TVar x U Γ T) {
-  case 1 then show ?case using SA_Trans_TVar
-    by (metis fst_conv imageI singletonD subsetI Type.set(1))
-next
-  case 2 then show ?case using SA_Trans_TVar by simp
-} qed auto
-
-declare ty.intros[intro]
-
-lemma ty_fresh_extend: "Γ,, x <: U ⊢ S <: T ⟹ x ∉ dom Γ ∪ FFVars_ctxt Γ ∧ x ∉ FFVars_Type U"
-  by (metis (no_types, lifting) UnE fst_conv snd_conv subsetD wf_ConsE wf_FFVars wf_context)
-
-make_binder_inductive ty
-  subgoal for R B σ Γ T1 T2
-    unfolding split_beta
-    by (elim disj_forward exE)
-      (auto simp add: isPerm_def supp_inv_bound map_context_def[symmetric] Type_vvsubst_rrename
-        Type.rrename_comps Type.FFVars_rrenames wf_eqvt extend_eqvt
-        | ((rule exI[of _ "σ _"] exI)+, (rule conjI)?, rule refl)
-        | ((rule exI[of _ "rrename_Type σ _"])+, (rule conjI)?, rule in_context_eqvt))+
-  subgoal premises prems for R B Γ T1 T2
-    using prems
+lemma ty_fresh_extend: "Γ,, x <: U ⊢ S <: T ⟹ x ∉ dom Γ ∪ FFVars_ctxt Γ ∧ x ∉ FFVars_sftypeP U"
+by (metis (no_types, lifting) UnE fst_conv snd_conv subsetD wf_ConsE wf_FFVars wf_context)
+
+make_binder_inductive (no_auto_refresh) ty
+  subgoal premises prems for R B Γ T1 T2
+    using prems
     unfolding ex_push_inwards conj_disj_distribL ex_disj_distrib
     apply (elim disj_forward exE; clarsimp)
      apply (((rule exI, rule conjI[rotated], assumption) |
           (((rule exI conjI)+)?, rule Forall_rrename) |
           (auto))+) []
-    subgoal premises prems for T1 S1 X S2 T2
-      using prems(3-)
+    subgoal premises prems for T1 S1 X S2 T2
+      using prems(3-)
       using exists_fresh[of "[X]" Γ T1 T2] apply(elim exE conjE)
       subgoal for Z
         apply (rule exI)
@@ -154,14 +138,14 @@ 
Theory SystemFSub

            apply (rule Forall_swap)
            apply simp
           apply assumption+
-         apply (frule prems(1)[rule_format, of "(Γ,, X <: T1)" "S2" "T2"])
-         apply (drule prems(2)[rule_format, of "id(X := Z, Z := X)" "Γ,, X <: T1" "S2" "T2", rotated 2])
+         apply (frule prems(1)[rule_format, of "(Γ,, X <: T1)" "S2" "T2"])
+         apply (drule prems(2)[rule_format, of "id(X := Z, Z := X)" "Γ,, X <: T1" "S2" "T2", rotated 2])
            apply (auto simp: extend_eqvt)
         apply(rule cong[OF cong[OF cong], THEN iffD1, of R , OF refl, rotated -1, 
-          of _ "rrename_Type (id(X := Z, Z := X)) S2"]) 
+          of _ "rrename_sftypeP (id(X := Z, Z := X)) S2"]) 
           apply (drule ty_fresh_extend)
           apply (simp_all add: supp_swap_bound)
-          by (metis (no_types, opaque_lifting) image_iff map_context_def map_context_swap_FFVars)
+          by (metis (no_types, opaque_lifting) image_iff map_context_swap_FFVars)
       done
     done
   done
diff --git a/html/System_Fsub/SystemFSub_Types.html b/html/System_Fsub/SystemFSub_Types.html
index 65489dfa..39d41e3b 100644
--- a/html/System_Fsub/SystemFSub_Types.html
+++ b/html/System_Fsub/SystemFSub_Types.html
@@ -12,7 +12,7 @@
 
Theory SystemFSub_Types

 
 
-
(* Types for System F with SubTypeing  *)
+
(* sftypePs for System F with SubsftypePing  *)
 theory SystemFSub_Types
   imports "Binders.MRBNF_Recursor"
     "Binders.Generic_Strong_Rule_Induction"
@@ -27,103 +27,103 @@ 
Theory SystemFSub_Types

 (*type_synonym label = nat*)
 
 declare [[mrbnf_internals]]
-binder_datatype 'var "Type" =
-    TyVar 'var
+binder_datatype 'tvar "sftypeP" =
+    TVr 'tvar
   | Top
-  | Fun "'var Type" "'var Type"
-  | Forall X::'var "'var Type" T::"'var Type" binds X in T
+  | Fun "'tvar sftypeP" "'tvar sftypeP"
+  | Forall X::'tvar "'tvar sftypeP" T::"'tvar sftypeP" binds X in T
 
-declare supp_swap_bound[OF cinfinite_imp_infinite[OF Type.UNIV_cinfinite], simp]
-declare Type.rrename_ids[simp] Type.rrename_id0s[simp]
+declare supp_swap_bound[OF cinfinite_imp_infinite[OF sftypeP.UNIV_cinfinite], simp]
+declare sftypeP.rrename_ids[simp] sftypeP.rrename_id0s[simp]
 
-lemma rrename_Type_simps[simp]:
-  fixes f::"'a::var_Type_pre ⇒ 'a"
+lemma rrename_sftypeP_simps[simp]:
+  fixes f::"'a::var_sftypeP_pre ⇒ 'a"
   assumes "bij f" "|supp f| <o |UNIV::'a set|"
   shows
-    "rrename_Type f (TyVar X) = TyVar (f X)"
-    "rrename_Type f Top = Top"
-    "rrename_Type f (Fun t1 t2) = Fun (rrename_Type f t1) (rrename_Type f t2)"
-    "rrename_Type f (Forall Y T1 T2) = Forall (f Y) (rrename_Type f T1) (rrename_Type f T2)"
-     apply (unfold TyVar_def Top_def Fun_def Forall_def)
+    "rrename_sftypeP f (TVr X) = TVr (f X)"
+    "rrename_sftypeP f Top = Top"
+    "rrename_sftypeP f (Fun t1 t2) = Fun (rrename_sftypeP f t1) (rrename_sftypeP f t2)"
+    "rrename_sftypeP f (Forall Y T1 T2) = Forall (f Y) (rrename_sftypeP f T1) (rrename_sftypeP f T2)"
+     apply (unfold TVr_def Top_def Fun_def Forall_def)
      apply (rule trans)
-      apply (rule Type.rrename_cctors)
-       apply (rule assms)+
+      apply (rule sftypeP.rrename_cctors)
+       apply (rule assms)+
      defer
      apply (rule trans)
-      apply (rule Type.rrename_cctors)
-       apply (rule assms)+
+      apply (rule sftypeP.rrename_cctors)
+       apply (rule assms)+
      defer
      apply (rule trans)
-      apply (rule Type.rrename_cctors)
-       apply (rule assms)+
+      apply (rule sftypeP.rrename_cctors)
+       apply (rule assms)+
      defer
      apply (rule trans)
-      apply (rule Type.rrename_cctors)
-       apply (rule assms)+
+      apply (rule sftypeP.rrename_cctors)
+       apply (rule assms)+
      defer
-     apply (unfold map_Type_pre_def comp_def Abs_Type_pre_inverse[OF UNIV_I] map_sum.simps
+     apply (unfold map_sftypeP_pre_def comp_def Abs_sftypeP_pre_inverse[OF UNIV_I] map_sum.simps
         map_prod_simp id_def
       )
      apply (rule refl)+
   done
 
-lemma Type_inject:
-  "TyVar X = TyVar Y ⟷ X = Y"
+lemma sftypeP_inject:
+  "TVr X = TVr Y ⟷ X = Y"
   "Fun T1 T2 = Fun R1 R2 ⟷ T1 = R1 ∧ T2 = R2"
   "Forall X T1 T2 = Forall Y R1 R2 ⟷ 
-   T1 = R1 ∧ (∃f. bij (f::'a::var_Type_pre ⇒ 'a) ∧ 
-   |supp f| <o |UNIV::'a set| ∧ id_on (FFVars_Type T2 - {X}) f ∧ f X = Y ∧ rrename_Type f T2 = R2)"
-    apply (unfold TyVar_def Fun_def Forall_def Type.TT_injects0
-      set3_Type_pre_def comp_def Abs_Type_pre_inverse[OF UNIV_I] map_sum.simps sum_set_simps
-      cSup_singleton Un_empty_left Un_empty_right Union_empty image_empty empty_Diff map_Type_pre_def
-      prod.map_id set2_Type_pre_def prod_set_simps prod.set_map UN_single Abs_Type_pre_inject[OF UNIV_I UNIV_I]
+   T1 = R1 ∧ (∃f. bij (f::'a::var_sftypeP_pre ⇒ 'a) ∧ 
+   |supp f| <o |UNIV::'a set| ∧ id_on (FFVars_sftypeP T2 - {X}) f ∧ f X = Y ∧ rrename_sftypeP f T2 = R2)"
+    apply (unfold TVr_def Fun_def Forall_def sftypeP.TT_injects0
+      set3_sftypeP_pre_def comp_def Abs_sftypeP_pre_inverse[OF UNIV_I] map_sum.simps sum_set_simps
+      cSup_singleton Un_empty_left Un_empty_right Union_empty image_empty empty_Diff map_sftypeP_pre_def
+      prod.map_id set2_sftypeP_pre_def prod_set_simps prod.set_map UN_single Abs_sftypeP_pre_inject[OF UNIV_I UNIV_I]
       sum.inject prod.inject map_prod_simp
     )
   by auto
-declare Type_inject(1,2)[simp]
+declare sftypeP_inject(1,2)[simp]
 
 corollary Forall_inject_same[simp]: "Forall X T1 T2 = Forall X S1 S2 ⟷ T1 = S1 ∧ T2 = S2"
-  using Type_inject(3) Type.rrename_cong_ids
+  using sftypeP_inject(3) sftypeP.rrename_cong_ids
   by (metis (no_types, lifting) Diff_empty Diff_insert0 id_on_insert insert_Diff)
 
-lemma Forall_rrename:
+lemma Forall_rrename:
   assumes "bij σ" "|supp σ| <o |UNIV::'a set|" shows "
- (⋀Y. Y∈FFVars_Type T2 - {X::'a::var_Type_pre} ⟹ σ Y = Y) ⟹ Forall X T1 T2 = Forall (σ X) T1 (rrename_Type σ T2)"
+ (⋀Y. Y∈FFVars_sftypeP T2 - {X::'a::var_sftypeP_pre} ⟹ σ Y = Y) ⟹ Forall X T1 T2 = Forall (σ X) T1 (rrename_sftypeP σ T2)"
   apply (unfold Forall_def)
-  apply (unfold Type.TT_injects0)
-  apply (unfold set3_Type_pre_def set2_Type_pre_def comp_def Abs_Type_pre_inverse[OF UNIV_I] map_sum.simps
+  apply (unfold sftypeP.TT_injects0)
+  apply (unfold set3_sftypeP_pre_def set2_sftypeP_pre_def comp_def Abs_sftypeP_pre_inverse[OF UNIV_I] map_sum.simps
     map_prod_simp sum_set_simps prod_set_simps cSup_singleton Un_empty_left Un_empty_right
-    Union_empty image_insert image_empty map_Type_pre_def id_def)
+    Union_empty image_insert image_empty map_sftypeP_pre_def id_def)
   apply (rule exI[of _ σ])
-  apply (rule conjI assms)+
+  apply (rule conjI assms)+
    apply (unfold id_on_def atomize_all atomize_imp)[1]
    apply (rule impI)
    apply assumption
   apply (rule refl)
   done
 
-lemma Forall_swap: "y ∉ FFVars_Type T2 - {x} ⟹ Forall (x::'a::var_Type_pre) T1 T2 = Forall y T1 (rrename_Type (id(x:=y,y:=x)) T2)"
+lemma Forall_swap: "y ∉ FFVars_sftypeP T2 - {x} ⟹ Forall (x::'a::var_sftypeP_pre) T1 T2 = Forall y T1 (rrename_sftypeP (id(x:=y,y:=x)) T2)"
   apply (rule trans)
    apply (rule Forall_rrename)
      apply (rule bij_swap[of x y])
     apply (rule supp_swap_bound)
-    apply (rule cinfinite_imp_infinite[OF Type.UNIV_cinfinite])
+    apply (rule cinfinite_imp_infinite[OF sftypeP.UNIV_cinfinite])
   by auto
 
 (* Monomorphising: *)
-instance var :: var_Type_pre apply standard
+instance var :: var_sftypeP_pre apply standard
   using Field_natLeq infinite_iff_card_of_nat infinite_var
   by (auto simp add: regularCard_var)
 
-type_synonym type = "var Type"
-type_synonym Γτ = "(var × type) list"
+type_synonym sftype = "var sftypeP"
+type_synonym Γτ = "(var × sftype) list"
 
-definition map_context :: "(var ⇒ var) ⇒ Γτ ⇒ Γτ" where
-  "map_context f ≡ map (map_prod f (rrename_Type f))"
+abbreviation map_context :: "(var ⇒ var) ⇒ Γτ ⇒ Γτ" where
+  "map_context f ≡ map (map_prod f (rrename_sftypeP f))"
 
 abbreviation FFVars_ctxt :: "Γτ ⇒ var set" where
-  "FFVars_ctxt xs ≡ ⋃(FFVars_Type ` snd ` set xs)"
-abbreviation extend :: "Γτ ⇒ var ⇒ type ⇒ Γτ" ("_ ,, _ <: _" [57,75,75] 71) where
+  "FFVars_ctxt xs ≡ ⋃(FFVars_sftypeP ` snd ` set xs)"
+abbreviation extend :: "Γτ ⇒ var ⇒ sftype ⇒ Γτ" ("_ ,, _ <: _" [57,75,75] 71) where
   "extend Γ x T ≡ (x, T)#Γ"
 abbreviation concat :: "Γτ ⇒ Γτ ⇒ Γτ" (infixl "(,,)" 71) where
   "concat Γ Δ ≡ Δ @ Γ"
@@ -133,14 +133,13 @@ 
Theory SystemFSub_Types

   "disjoint Γ Δ ≡ dom Γ ∩ dom Δ = {}"
 
 lemma map_context_id[simp]: "map_context id = id"
-  unfolding map_context_def by simp
+  by simp
 
-lemma map_context_comp0[simp]:
+lemma map_context_comp0[simp]:
   assumes "bij f" "|supp f| <o |UNIV::var set|" "bij g" "|supp g| <o |UNIV::var set|"
   shows "map_context f ∘ map_context g = map_context (f ∘ g)"
   apply (rule ext)
-  unfolding map_context_def
-  using assms by (auto simp: Type.rrename_comps)
+  using assms by (auto simp: sftypeP.rrename_comps)
 
 lemmas map_context_comp = trans[OF comp_apply[symmetric] fun_cong[OF map_context_comp0]]
 declare map_context_comp[simp]
@@ -148,11 +147,11 @@ 
Theory SystemFSub_Types

 lemma context_dom_set[simp]:
   assumes "bij f" "|supp f| <o |UNIV::var set|"
   shows "dom (map_context f xs) = f ` dom xs"
-  unfolding map_context_def by force
+  by force
 lemma set_bd_UNIV: "|set xs| <o |UNIV::var set|"
   apply (rule ordLess_ordLeq_trans)
     apply (tactic ‹resolve_tac @{context} (BNF_Def.set_bd_of_bnf (the (BNF_Def.bnf_of @{context} @{type_name list}))) 1›)
-  apply (rule var_Type_pre_class.large)
+  apply (rule var_sftypeP_pre_class.large)
   done
 
 lemma context_set_bd_UNIV[simp]: "|dom xs| <o |UNIV::var set|"
@@ -160,29 +159,28 @@ 
Theory SystemFSub_Types

   apply (rule set_bd_UNIV)
   done
 
-lemma context_map_cong_id:
+lemma context_map_cong_id:
   assumes "bij f" "|supp f| <o |UNIV::var set|"
   and "⋀a. a ∈ dom Γ ∪ FFVars_ctxt Γ ⟹ f a = a"
 shows "map_context f Γ = Γ"
-  unfolding map_context_def
   apply (rule trans)
    apply (rule list.map_cong0[of _ _ id])
    apply (rule trans)
     apply (rule prod.map_cong0[of _ _ id _ id])
-  using assms by (fastforce intro!: Type.rrename_cong_ids)+
+  using assms by (fastforce intro!: sftypeP.rrename_cong_ids)+
 
 lemma ls_UNIV_iff_finite: "|A| <o |UNIV::var set| ⟷ finite A"
 using finite_iff_le_card_var by blast
 
-lemma rrename_swap_FFvars[simp]: "X ∉ FFVars_Type T ⟹ Y ∉ FFVars_Type T ⟹
-  rrename_Type (id(X := Y, Y := X)) T = T"
-apply(rule Type.rrename_cong_ids) by auto
+lemma rrename_swap_FFvars[simp]: "X ∉ FFVars_sftypeP T ⟹ Y ∉ FFVars_sftypeP T ⟹
+  rrename_sftypeP (id(X := Y, Y := X)) T = T"
+apply(rule sftypeP.rrename_cong_ids) by auto
 
 lemma map_context_swap_FFVars[simp]:
-"∀k∈set Γ. X ≠ fst k ∧ X ∉ FFVars_Type (snd k) ∧
-           Y ≠ fst k ∧ Y ∉ FFVars_Type (snd k) ⟹
+"∀k∈set Γ. X ≠ fst k ∧ X ∉ FFVars_sftypeP (snd k) ∧
+           Y ≠ fst k ∧ Y ∉ FFVars_sftypeP (snd k) ⟹
     map_context (id(X := Y, Y := X)) Γ = Γ"
-  unfolding map_context_def apply(rule map_idI) by auto
+  apply(rule map_idI) by auto
 
 lemma isPerm_swap: "isPerm (id(X := Y, Y := X))"
   unfolding isPerm_def by (auto simp: supp_swap_bound infinite_UNIV)
diff --git a/html/System_Fsub/session_graph.pdf b/html/System_Fsub/session_graph.pdf
index 96049860..4d2aabe5 100644
Binary files a/html/System_Fsub/session_graph.pdf and b/html/System_Fsub/session_graph.pdf differ
diff --git a/html/Untyped_Lambda_Calculus/.browser_info/build_uuid b/html/Untyped_Lambda_Calculus/.browser_info/build_uuid
index 870be435..60934cd8 100644
--- a/html/Untyped_Lambda_Calculus/.browser_info/build_uuid
+++ b/html/Untyped_Lambda_Calculus/.browser_info/build_uuid
@@ -1 +1 @@
-785da145-7f99-4401-8912-50097c36170b
\ No newline at end of file
+2aae4740-5a4c-458c-b26c-cca8e1759a7e
\ No newline at end of file
diff --git a/html/Untyped_Lambda_Calculus/LC.html b/html/Untyped_Lambda_Calculus/LC.html
index 4b38962c..7fadefd5 100644
--- a/html/Untyped_Lambda_Calculus/LC.html
+++ b/html/Untyped_Lambda_Calculus/LC.html
@@ -24,7 +24,7 @@ 
Theory LC

 (* DATATYPE DECLARTION  *)
 
 declare [[mrbnf_internals]]
-binder_datatype 'var "ltermP" =
+binder_datatype 'var "ltermP" =
   Vr 'var
 | Ap "'var ltermP" "'var ltermP"
 | Lm x::'var t::"'var ltermP" binds x in t
@@ -42,7 +42,7 @@ 
Theory LC

   by (auto simp add: regularCard_var)
 
 instance var::cinf
-apply standard 
+apply standard
   subgoal apply(rule exI[of _ "inv Variable"])
   by (simp add: bij_Variable bij_is_inj)
   subgoal using infinite_var . .
@@ -63,17 +63,17 @@ 
Theory LC

 abbreviation "rrename ≡ rrename_ltermP"
 (* *)
 
-lemma FFVars_tvsubst[simp]:
+lemma FFVars_tvsubst[simp]:
   assumes "|SSupp (σ :: var ⇒ lterm)| <o |UNIV :: var set|"
   shows "FFVars (tvsubst σ t) = (⋃ {FFVars (σ x) | x . x ∈ FFVars t})"
   apply (binder_induction t avoiding: "IImsupp σ" rule: ltermP.strong_induct)
-     apply (auto simp: IImsupp_def assms intro!: Un_bound UN_bound ltermP.card_of_FFVars_bounds)
+     apply (auto simp: IImsupp_def assms intro!: Un_bound UN_bound ltermP.card_of_FFVars_bounds)
   using ltermP.FVars_VVr apply (fastforce simp add: SSupp_def)
   using ltermP.FVars_VVr apply (auto simp add: SSupp_def)
   by (smt (verit) singletonD ltermP.FVars_VVr)
 
-lemma fsupp_le[simp]: 
-"fsupp (σ::var⇒var) ⟹ |supp σ| <o |UNIV::var set|" 
+lemma fsupp_le[simp]:
+"fsupp (σ::var⇒var) ⟹ |supp σ| <o |UNIV::var set|"
 by (simp add: finite_card_var fsupp_def supp_def)
 
 (* Enabling some simplification rules: *)
@@ -112,8 +112,8 @@ 
Theory LC

     apply (rule case_split[of "isVVr (ltermP_ctor x)"])
      apply (unfold isVVr_def)[1]
      apply (erule exE)
-    subgoal premises prems for a
-      unfolding prems
+    subgoal premises prems for a
+      unfolding prems
       apply (rule ltermP.tvsubst_VVr)
       apply (rule ltermP.SSupp_VVr_bound)
         done
@@ -139,41 +139,31 @@ 
Theory LC

       done
     done
 
-proposition rrename_simps[simp]:
-  assumes "bij (f::var ⇒ var)" "|supp f| <o |UNIV::var set|"
-  shows "rrename f (Vr a) = Vr (f a)"
-    "rrename f (Ap e1 e2) = Ap (rrename f e1) (rrename f e2)"
-    "rrename f (Lm x e) = Lm (f x) (rrename f e)"
-  unfolding Vr_def Ap_def Lm_def ltermP.rrename_cctors[OF assms] map_ltermP_pre_def comp_def
-    Abs_ltermP_pre_inverse[OF UNIV_I] map_sum_def sum.case map_prod_def prod.case id_def
-    apply (rule refl)+
-  done
-
-lemma rrename_cong:
+lemma rrename_cong:
 assumes "bij f" "|supp f| <o |UNIV::var set|" "bij g" "|supp g| <o |UNIV::var set|"
 "(⋀z. (z::var) ∈ FFVars P ⟹ f z = g z)"
 shows "rrename f P = rrename g P"
-using assms(5) apply(binder_induction P avoiding: "supp f" "supp g" rule: ltermP.strong_induct)
-using assms apply auto by (metis not_in_supp_alt)+
+using assms(5) apply(binder_induction P avoiding: "supp f" "supp g" rule: ltermP.strong_induct)
+using assms apply auto by (metis not_in_supp_alt)+
 
 lemma tvsubst_cong:
-assumes f: "|SSupp f| <o |UNIV::var set|" and g: "|SSupp g| <o |UNIV::var set|"
-and eq: "(⋀z. (z::var) ∈ FFVars P ⟹ f z = g z)"
+assumes f: "|SSupp f| <o |UNIV::var set|" and g: "|SSupp g| <o |UNIV::var set|"
+and eq: "(⋀z. (z::var) ∈ FFVars P ⟹ f z = g z)"
 shows "tvsubst f P = tvsubst g P"
 proof-
-  have fg: "|IImsupp f| <o |UNIV::var set|" "|IImsupp g| <o |UNIV::var set|" 
-    using f g  
+  have fg: "|IImsupp f| <o |UNIV::var set|" "|IImsupp g| <o |UNIV::var set|" 
+    using f g  
     by (simp_all add: IImsupp_def ltermP.card_of_FFVars_bounds 
        ltermP_prevar_ltermP_prevar_ltermP_prevar_prodIDltermP_prevar_prodIDsum_class.UN_bound 
        ltermP_prevar_ltermP_prevar_ltermP_prevar_prodIDltermP_prevar_prodIDsum_class.Un_bound) 
-  have 0: "|IImsupp f ∪ IImsupp g| <o |UNIV::var set|" 
-    using fg var_ltermP_pre_class.Un_bound by blast
-  show ?thesis using 0 eq apply(binder_induction P avoiding: "IImsupp f" "IImsupp g" rule: ltermP.strong_induct)
-    subgoal using fg by auto
-    subgoal using fg by simp  
-    subgoal using f g by simp
-    subgoal using f g by simp
-    subgoal using f g fg apply simp unfolding IImsupp_def SSupp_def 
+  have 0: "|IImsupp f ∪ IImsupp g| <o |UNIV::var set|" 
+    using fg var_ltermP_pre_class.Un_bound by blast
+  show ?thesis using 0 eq apply(binder_induction P avoiding: "IImsupp f" "IImsupp g" rule: ltermP.strong_induct)
+    subgoal using fg by auto
+    subgoal using fg by simp
+    subgoal using f g by simp
+    subgoal using f g by simp
+    subgoal using f g fg apply simp unfolding IImsupp_def SSupp_def
     by auto metis .
 qed
 
@@ -302,8 +292,7 @@ 
Theory LC

 lemma Lm_rrename:
 "bij (σ::var⇒var) ⟹ |supp σ| <o |UNIV:: var set| ⟹
  (⋀a'. a' ∈FFVars_ltermP e - {a::var} ⟹ σ a' = a') ⟹ Lm a e = Lm (σ a) (rrename σ e)"
-by (metis rrename_simps(3) ltermP.rrename_cong_ids ltermP.set(3))
-
+by (metis ltermP.permute(3) ltermP.rrename_cong_ids ltermP.set(3))
 
 (* Bound properties (needed as auxiliaries): *)
 
@@ -315,14 +304,72 @@ 
Theory LC

       elim!: ordLeq_ordLess_trans[OF card_of_mono1 ordLess_ordLeq_trans[OF ltermP_pre.Un_bound], rotated, of _ "{a}"]
       intro: card_of_mono1)
 
+lemma SSupp_upd_Vr_bound[simp,intro!]: "|SSupp (Vr(x::'a := t))| <o |UNIV::'a::var_ltermP_pre set|"
+  unfolding VVr_eq_Vr fun_upd_def SSupp_def
+  by (auto split: if_splits) (metis (mono_tags, lifting) card_of_subset_bound insert_subset mem_Collect_eq subsetI ltermP.card_of_FFVars_bounds ltermP.set(1))
+
+lemma tusubst_equiv[equiv]:
+  fixes σ::"'a::var_ltermP_pre ⇒ 'a"
+  assumes "bij σ" "|supp σ| <o |UNIV::'a set|"
+  shows "rrename σ (tvsubst (Vr(x := t')) t) = tvsubst (Vr(σ x := rrename σ t')) (rrename σ t)"
+  apply (rule trans)
+   apply (rule trans[OF comp_apply[symmetric] ltermP.rrename_tvsubst[THEN fun_cong]])
+     apply (rule assms)+
+   apply (rule SSupp_upd_Vr_bound)
+  apply (unfold comp_def fun_upd_def)
+  apply (rule arg_cong2[OF _ refl, of _ _ tvsubst])
+  apply (rule ext)
+  apply (rule case_split)
+   apply (rule sym)
+   apply (rule trans[OF if_P])
+    apply (erule sym)
+   apply (subst if_P)
+    apply (erule subst)
+    apply (rule inv_simp1)
+    apply (rule assms)
+   apply (rule refl)
+  apply (subst if_not_P)
+   apply (erule contrapos_nn)
+   apply hypsubst_thin
+   apply (rule inv_simp2)
+   apply (rule assms)
+  apply (subst if_not_P)
+   apply (erule contrapos_nn)
+   apply (erule sym)
+  apply (rule trans)
+   apply (rule ltermP.permute)
+    apply (rule assms)+
+  apply (rule arg_cong[of _ _ Vr])
+  apply (rule inv_simp2)
+  apply (rule assms)
+  done
+
+lemma fun_upd_equiv[equiv]:
+  fixes σ::"'a::var_ltermP_pre ⇒ 'a"
+  assumes "bij σ" "|supp σ| <o |UNIV::'a set|"
+    and equiv: "⋀x. rrename σ (f x) = f (σ x)"
+  shows "rrename σ ((f(x := t)) y) = (f(σ x := rrename σ t)) (σ y)"
+  apply (unfold comp_def fun_upd_def)
+  apply (rule case_split)
+   apply (subst if_P)
+    apply assumption
+   apply hypsubst_thin
+   apply (subst if_P)
+    apply (rule refl)
+   apply (rule refl)
+  apply (unfold if_not_P)
+  apply (subst if_not_P)
+   apply (erule contrapos_nn)
+   apply (erule injD[OF bij_is_inj, rotated])
+   apply (rule assms)
+  apply (rule equiv)
+  done
+
 corollary SSupp_upd_VVr_bound[simp,intro!]: "|SSupp (VVr(a:=(t::lterm)))| <o |UNIV::var set|"
   apply (rule iffD2[OF SSupp_upd_bound])
   apply (rule ltermP.SSupp_VVr_bound)
   done
 
-lemma SSupp_upd_Vr_bound[simp,intro!]: "|SSupp (Vr(a:=(t::lterm)))| <o |UNIV::var set|"
-using SSupp_upd_VVr_bound by auto
-
 lemma supp_swap_bound[simp,intro!]: "|supp (id(x::var := xx, xx := x))| <o |UNIV:: var set|"
 by (simp add: cinfinite_imp_infinite supp_swap_bound ltermP.UNIV_cinfinite)
 
@@ -333,32 +380,32 @@ 
Theory LC

 (* *)
 
 lemma IImsupp_tvsubst_su:
-assumes s[simp]: "|SSupp σ| <o  |UNIV:: var set|"
+assumes s[simp]: "|SSupp σ| <o  |UNIV:: var set|"
 shows "IImsupp (tvsubst (σ::var⇒lterm) o τ) ⊆ IImsupp σ ∪ IImsupp τ"
 unfolding IImsupp_def SSupp_def apply auto
-by (metis s singletonD ltermP.set(1) ltermP.subst(1))
+by (metis s singletonD ltermP.set(1) ltermP.subst(1))
 
-lemma IImsupp_tvsubst_su':
+lemma IImsupp_tvsubst_su':
 assumes s[simp]: "|SSupp σ| <o  |UNIV:: var set|"
 shows "IImsupp (λa. tvsubst (σ::var⇒lterm) (τ a)) ⊆ IImsupp σ ∪ IImsupp τ"
-using IImsupp_tvsubst_su[OF assms] unfolding o_def .
+using IImsupp_tvsubst_su[OF assms] unfolding o_def .
 
 lemma IImsupp_tvsubst_bound:
-assumes s: "|SSupp σ| <o |UNIV:: var set|" "|SSupp τ| <o |UNIV:: var set|"
+assumes s: "|SSupp σ| <o |UNIV:: var set|" "|SSupp τ| <o |UNIV:: var set|"
 shows "|IImsupp (tvsubst (σ::var⇒lterm) o τ)| <o |UNIV:: var set|"
-using IImsupp_tvsubst_su[OF s(1)] s
+using IImsupp_tvsubst_su[OF s(1)] s
 by (meson Un_bound SSupp_IImsupp_bound card_of_subset_bound)
 
-lemma SSupp_tvsubst_bound:
+lemma SSupp_tvsubst_bound:
 assumes s: "|SSupp σ| <o |UNIV:: var set|" "|SSupp τ| <o |UNIV:: var set|"
 shows "|SSupp (tvsubst (σ::var⇒lterm) o τ)| <o |UNIV:: var set|"
-using IImsupp_tvsubst_bound[OF assms]
+using IImsupp_tvsubst_bound[OF assms]
 by (metis IImsupp_def card_of_subset_bound sup_ge1)
 
-lemma SSupp_tvsubst_bound':
+lemma SSupp_tvsubst_bound':
 assumes s: "|SSupp σ| <o |UNIV:: var set|" "|SSupp τ| <o |UNIV:: var set|"
 shows "|SSupp (λa. tvsubst (σ::var⇒lterm) (τ a))| <o |UNIV:: var set|"
-using SSupp_tvsubst_bound[OF assms] unfolding o_def .
+using SSupp_tvsubst_bound[OF assms] unfolding o_def .
 
 (* *)
 
@@ -373,27 +420,27 @@ 
Theory LC

 shows "IImsupp (rrename (σ::var⇒var) o τ) ⊆ imsupp σ ∪ IImsupp τ"
 unfolding IImsupp_def imsupp_def supp_def SSupp_def by force
 
-lemma IImsupp_rrename_su':
+lemma IImsupp_rrename_su':
 assumes s[simp]: "bij (σ::var⇒var)" "|supp σ| <o  |UNIV:: var set|"
 shows "IImsupp (λa. rrename (σ::var⇒var) (τ a)) ⊆ imsupp σ ∪ IImsupp τ"
-using IImsupp_rrename_su[OF assms] unfolding o_def .
+using IImsupp_rrename_su[OF assms] unfolding o_def .
 
 lemma IImsupp_rrename_bound:
-assumes s: "bij (σ::var⇒var)" "|supp σ| <o  |UNIV:: var set|" "|SSupp τ| <o |UNIV:: var set|"
+assumes s: "bij (σ::var⇒var)" "|supp σ| <o  |UNIV:: var set|" "|SSupp τ| <o |UNIV:: var set|"
 shows "|IImsupp (rrename (σ::var⇒var) o τ)| <o |UNIV:: var set|"
-using IImsupp_rrename_su[OF s(1,2)] s
+using IImsupp_rrename_su[OF s(1,2)] s
 by (metis SSupp_IImsupp_bound finite_Un finite_iff_le_card_var finite_subset imsupp_supp_bound infinite_var)
 
-lemma SSupp_rrename_bound:
+lemma SSupp_rrename_bound:
 assumes s: "bij (σ::var⇒var)" "|supp σ| <o  |UNIV:: var set|" "|SSupp τ| <o |UNIV:: var set|"
 shows "|SSupp (rrename (σ::var⇒var) o τ)| <o |UNIV:: var set|"
-using IImsupp_rrename_bound[OF assms]
+using IImsupp_rrename_bound[OF assms]
 by (metis IImsupp_def card_of_subset_bound sup_ge1)
 
-lemma SSupp_rrename_bound':
+lemma SSupp_rrename_bound':
 assumes s: "bij (σ::var⇒var)" "|supp σ| <o  |UNIV:: var set|" "|SSupp τ| <o |UNIV:: var set|"
 shows "|SSupp (λa. rrename (σ::var⇒var) (τ a))| <o |UNIV:: var set|"
-using SSupp_rrename_bound[OF assms] unfolding o_def .
+using SSupp_rrename_bound[OF assms] unfolding o_def .
 
 (* *)
 lemma SSupp_update_rrename_bound:
@@ -406,61 +453,61 @@ 
Theory LC

        imsupp σ ∪ {x} ∪ FFVars_ltermP e"
 unfolding IImsupp_def SSupp_def imsupp_def supp_def by (auto split: if_splits)
 
-lemma IImsupp_rrename_update_bound:
-assumes s[simp]: "bij (σ::var⇒var)" "|supp σ| <o |UNIV::var set|"
+lemma IImsupp_rrename_update_bound:
+assumes s[simp]: "bij (σ::var⇒var)" "|supp σ| <o |UNIV::var set|"
 shows "|IImsupp (rrename σ ∘ Vr(x := e))| <o |UNIV::var set|"
-using IImsupp_rrename_update_su[OF assms]
-by (meson Un_bound card_of_subset_bound imsupp_supp_bound infinite_var s(2) singl_bound ltermP.set_bd_UNIV)
+using IImsupp_rrename_update_su[OF assms]
+by (meson Un_bound card_of_subset_bound imsupp_supp_bound infinite_var s(2) singl_bound ltermP.set_bd_UNIV)
 
-lemma SSupp_rrename_update_bound:
+lemma SSupp_rrename_update_bound:
 assumes s[simp]: "bij (σ::var⇒var)" "|supp σ| <o |UNIV::var set|"
 shows "|SSupp (rrename σ ∘ Vr(x := e))| <o |UNIV::var set|"
-using IImsupp_rrename_update_bound[OF assms]
+using IImsupp_rrename_update_bound[OF assms]
   by (metis (mono_tags) IImsupp_def finite_Un finite_iff_le_card_var)
 
 (* Action of swapping (a particular renaming) on variables *)
 
 lemma rrename_swap_Vr1[simp]: "rrename (id(x := xx, xx := x)) (Vr (x::var)) = Vr xx"
-apply(subst rrename_simps(1)) by auto
+apply(subst ltermP.permute(1)) by auto
 lemma rrename_swap_Vr2[simp]: "rrename (id(x := xx, xx := x)) (Vr (xx::var)) = Vr x"
-apply(subst rrename_simps(1)) by auto
+apply(subst ltermP.permute(1)) by auto
 lemma rrename_swap_Vr3[simp]: "z ∉ {x,xx} ⟹ rrename (id(x := xx, xx := x)) (Vr (z::var)) = Vr z"
-apply(subst rrename_simps(1)) by auto
+apply(subst ltermP.permute(1)) by auto
 lemma rrename_swap_Vr[simp]: "rrename (id(x := xx, xx := x)) (Vr (z::var)) =
  Vr (if z = x then xx else if z = xx then x else z)"
-apply(subst rrename_simps(1)) by auto
+apply(subst ltermP.permute(1)) by auto
 
 (* Compositionality properties of renaming and ltermP-for-variable substitution *)
 
 lemma tvsubst_comp:
-assumes s[simp]: "|SSupp σ| <o |UNIV:: var set|" "|SSupp τ| <o |UNIV:: var set|"
+assumes s[simp]: "|SSupp σ| <o |UNIV:: var set|" "|SSupp τ| <o |UNIV:: var set|"
 shows "tvsubst (σ::var⇒lterm) (tvsubst τ e) = tvsubst (tvsubst σ ∘ τ) e"
 proof-
-  note SSupp_tvsubst_bound'[OF s, simp]
+  note SSupp_tvsubst_bound'[OF s, simp]
   show ?thesis
   apply(induct e rule: ltermP.fresh_induct[where A = "IImsupp σ ∪ IImsupp τ"])
-    subgoal using Un_bound[OF s]
-      using var_ID_class.Un_bound SSupp_IImsupp_bound s(1) s(2) by blast
+    subgoal using Un_bound[OF s]
+      using var_ID_class.Un_bound SSupp_IImsupp_bound s(1) s(2) by blast
     subgoal by simp
     subgoal by simp
     subgoal for x t apply(subgoal_tac "x ∉ IImsupp (λa. tvsubst σ (τ a))")
       subgoal by simp
-      subgoal using IImsupp_tvsubst_su'[OF s(1)] by blast . .
+      subgoal using IImsupp_tvsubst_su'[OF s(1)] by blast . .
 qed
 
 lemma rrename_tvsubst_comp:
-assumes b[simp]: "bij (σ::var⇒var)" and s[simp]: "|supp σ| <o |UNIV:: var set|" "|SSupp τ| <o |UNIV:: var set|"
+assumes b[simp]: "bij (σ::var⇒var)" and s[simp]: "|supp σ| <o |UNIV:: var set|" "|SSupp τ| <o |UNIV:: var set|"
 shows "rrename σ (tvsubst τ e) = tvsubst (rrename σ ∘ τ) e"
 proof-
-  note SSupp_rrename_bound'[OF b s, simp]
+  note SSupp_rrename_bound'[OF b s, simp]
   show ?thesis
   apply(induct e rule: ltermP.fresh_induct[where A = "IImsupp τ ∪ imsupp σ"])
-    subgoal using s(1) s(2) Un_bound SSupp_IImsupp_bound imsupp_supp_bound infinite_var by blast
+    subgoal using s(1) s(2) Un_bound SSupp_IImsupp_bound imsupp_supp_bound infinite_var by blast
     subgoal by simp
     subgoal by simp
     subgoal for x t apply simp apply(subgoal_tac "x ∉ IImsupp (λa. rrename  σ (τ a))")
       subgoal unfolding imsupp_def supp_def by simp
-      subgoal using IImsupp_rrename_su' b s(1) by blast . .
+      subgoal using IImsupp_rrename_su' b s(1) by blast . .
 qed
 
 
@@ -469,7 +516,7 @@ 
Theory LC

 lemma supp_SSupp_Vr_le[simp]: "SSupp (Vr ∘ σ) = supp σ" 
 unfolding supp_def SSupp_def by simp
 
-lemma rrename_eq_tvsubst_Vr: 
+lemma rrename_eq_tvsubst_Vr: 
 assumes "bij (σ::var⇒var)" "|supp σ| <o |UNIV::var set|" 
 shows "rrename σ = tvsubst (Vr o σ)"
 proof
@@ -477,11 +524,11 @@ 
Theory LC

   show "rrename σ t = tvsubst (Vr o σ) t"
   proof (binder_induction t avoiding: "IImsupp (Vr ∘ σ)" rule: ltermP.strong_induct)
     case Bound
-    then show ?case using assms SSupp_IImsupp_bound by (metis supp_SSupp_Vr_le)
+    then show ?case using assms SSupp_IImsupp_bound by (metis supp_SSupp_Vr_le)
   next
     case (Lm x1 x2)
-    then show ?case by (simp add: assms IImsupp_def disjoint_iff not_in_supp_alt)
-  qed (auto simp: assms)
+    then show ?case by (simp add: assms IImsupp_def disjoint_iff not_in_supp_alt)
+  qed (auto simp: assms)
 qed
      
 lemma rrename_eq_tvsubst_Vr': 
@@ -490,15 +537,15 @@ 
Theory LC

 
 (* Equivariance of unary substitution: *)
 
-lemma tvsubst_rrename_comp[simp]:
-assumes s[simp]: "bij (σ::var⇒var)" "|supp σ| <o |UNIV::var set|"
+lemma tvsubst_rrename_comp[simp]:
+assumes s[simp]: "bij (σ::var⇒var)" "|supp σ| <o |UNIV::var set|"
 shows "tvsubst (rrename σ ∘ Vr(x := e2)) e1 = tvsubst (Vr(σ x := rrename σ e2)) (rrename σ e1)"
 proof-
-  note SSupp_rrename_update_bound[OF assms, unfolded comp_def, simplified, simp]
+  note SSupp_rrename_update_bound[OF assms, unfolded comp_def, simplified, simp]
   note SSupp_update_rrename_bound[unfolded fun_upd_def, simplified, simp]
   show ?thesis
   apply(induct e1 rule: ltermP.fresh_induct[where A = "{x} ∪ FFVars_ltermP e2 ∪ imsupp σ"])
-    subgoal by (meson Un_bound imsupp_supp_bound infinite_var s(2) singl_bound ltermP.set_bd_UNIV)
+    subgoal by (meson Un_bound imsupp_supp_bound infinite_var s(2) singl_bound ltermP.set_bd_UNIV)
     subgoal by auto
     subgoal by simp
     subgoal for y t apply simp apply(subgoal_tac
@@ -510,10 +557,10 @@ 
Theory LC

 
 (* Unary substitution versus swapping: *)
 lemma tvsubst_refresh:
-assumes xx: "xx ∉ FFVars_ltermP e1 - {x}"
+assumes xx: "xx ∉ FFVars_ltermP e1 - {x}"
 shows "tvsubst (Vr((x::var) := e2)) e1 = tvsubst (Vr(xx := e2)) (rrename (id(x := xx, xx := x)) e1)"
 proof-
-  show ?thesis using xx
+  show ?thesis using xx
   apply(induct e1 rule: ltermP.fresh_induct[where A = "{x,xx} ∪ FFVars_ltermP e2"])
     subgoal by (metis insert_is_Un ltermP.set(1) ltermP.set(2) ltermP.set_bd_UNIV)
     subgoal by simp
@@ -534,12 +581,12 @@ 
Theory LC

 
 (* *)
 
-lemma usub_swap_disj:
+lemma usub_swap_disj:
 assumes "{u,v} ∩ {x,y} = {}"
 shows "usub (swap t u v) x y = swap (usub t x y) u v"
 proof-
   note ltermP_vvsubst_rrename[simp del]
-  show ?thesis using assms
+  show ?thesis using assms
   apply(subst ltermP_vvsubst_rrename[symmetric]) apply auto
   apply(subst ltermP.map_comp) apply auto
   apply(subst ltermP_vvsubst_rrename[symmetric]) apply auto
@@ -614,12 +661,12 @@ 
Theory LC

 
 (* *)
 
-lemma rrename_usub[simp]:
+lemma rrename_usub[simp]:
 assumes σ: "bij σ" "|supp σ| <o |UNIV::var set|"
 shows "rrename σ (usub t u (x::var)) = usub (rrename σ t) (σ u) (σ x)"
-using assms
+using assms
 apply(binder_induction t avoiding: "supp σ" u x rule: ltermP.strong_induct)
-using assms by (auto simp: sb_def)
+using assms by (auto simp: sb_def)
 
 lemma sw_sb:
 "sw (sb z u x) z1 z2 = sb (sw z z1 z2) (sw u z1 z2) (sw x z1 z2)"
@@ -638,12 +685,12 @@ 
Theory LC

       subgoal unfolding sw_def sb_def by auto
       unfolding sw_sb by presburger . .
 
-lemma usub_refresh:
+lemma usub_refresh:
 assumes "xx ∉ FFVars t ∨ xx = x"
 shows "usub t u x = usub (swap t x xx) u xx"
 proof-
   note ltermP_vvsubst_rrename[simp del]
-  show ?thesis using assms
+  show ?thesis using assms
   apply(subst ltermP_vvsubst_rrename[symmetric]) apply simp
     subgoal by auto
     subgoal apply(subst ltermP.map_comp)
@@ -701,7 +748,7 @@ 
Theory LC

 (* *)
 (* Substitution from a sequence (here, a list) *)
 
-(* "making" the substitution function that maps each xs_i to es_i; only 
+(* "making" the substitution function that maps each xs_i to es_i; only
 meaningful if xs is non-repetitive *)
 definition "mkSubst xs es ≡ λx. if distinct xs ∧ x ∈ set xs then nth es (theN xs x) else Vr x"
 
@@ -712,7 +759,7 @@ 
Theory LC

 unfolding mkSubst_def by auto
 
 lemma card_set_var: "|set xs| <o |UNIV::var set|"
-by (simp add: infinite_var) 
+by (simp add: infinite_var)
 
 lemma SSupp_mkSubst[simp,intro]: "|SSupp (mkSubst xs es)| <o |UNIV::var set|"
 proof-
@@ -721,38 +768,38 @@ 
Theory LC

   thus ?thesis by (simp add: card_of_subset_bound card_set_var)
 qed
 
-lemma mkSubst_map_rrename: 
-assumes s: "bij (σ::var⇒var)" "|supp σ| <o |UNIV::var set|" 
-and l: "length es2 = length xs"
+lemma mkSubst_map_rrename:
+assumes s: "bij (σ::var⇒var)" "|supp σ| <o |UNIV::var set|"
+and l: "length es2 = length xs"
 shows "mkSubst (map σ xs) (map (rrename σ) es2) ∘ σ = rrename σ ∘ mkSubst xs es2"
-proof(rule ext)  
+proof(rule ext)
   fix x
   show "(mkSubst (map σ xs) (map (rrename σ) es2) ∘ σ) x = (rrename σ ∘ mkSubst xs es2) x"
   proof(cases "distinct xs ∧ x ∈ set xs")
-    case False
-    hence F: "¬ distinct (map σ xs) ∨ ¬ σ x ∈ set (map σ xs)"
-    using s by auto
-    thus ?thesis using F False
-    unfolding o_def apply(subst mkSubst_idle) 
+    case False
+    hence F: "¬ distinct (map σ xs) ∨ ¬ σ x ∈ set (map σ xs)"
+    using s by auto
+    thus ?thesis using F False
+    unfolding o_def apply(subst mkSubst_idle)
       subgoal by auto
-      subgoal using s by auto .
+      subgoal using s by auto .
   next
     case True
-    then obtain i where i: "i < length xs" and Tr: "distinct xs" and Tri: "x = nth xs i" by (metis theN)
-    hence T: "distinct (map σ xs)" and Ti: "σ x = nth (map σ xs) i"
-    using s by auto
-    thus ?thesis using T Tr
-    unfolding o_def Ti apply(subst mkSubst_nth) 
+    then obtain i where i: "i < length xs" and Tr: "distinct xs" and Tri: "x = nth xs i" by (metis theN)
+    hence T: "distinct (map σ xs)" and Ti: "σ x = nth (map σ xs) i"
+    using s by auto
+    thus ?thesis using T Tr
+    unfolding o_def Ti apply(subst mkSubst_nth)
       subgoal by auto
-      subgoal using i unfolding Tri by auto 
-      subgoal using l i unfolding Tri by auto .
+      subgoal using i unfolding Tri by auto
+      subgoal using l i unfolding Tri by auto .
   qed
 qed
 
-lemma mkSubst_map_rrename_inv: 
+lemma mkSubst_map_rrename_inv:
 assumes "bij (σ::var⇒var)" "|supp σ| <o |UNIV::var set|" "length es2 = length xs"
 shows "mkSubst (map σ xs) (map (rrename σ) es2) = rrename σ ∘ mkSubst xs es2 o inv σ"
-unfolding mkSubst_map_rrename[OF assms, symmetric] using assms unfolding fun_eq_iff by auto
+unfolding mkSubst_map_rrename[OF assms, symmetric] using assms unfolding fun_eq_iff by auto
 
 lemma card_SSupp_itvsubst_mkSubst_rrename_inv: 
 "bij (σ::var⇒var) ⟹ |supp σ| <o |UNIV::var set| ⟹ 
@@ -760,102 +807,100 @@ 
Theory LC

 |SSupp (tvsubst (rrename σ ∘ mkSubst xs es ∘ inv σ) ∘ (Vr ∘ σ))| <o |UNIV::var set|"
 by (metis SSupp_tvsubst_bound SSupp_mkSubst mkSubst_map_rrename_inv supp_SSupp_Vr_le)
 
-lemma card_SSupp_mkSubst_rrename_inv: 
-"bij (σ::var⇒var) ⟹ |supp σ| <o |UNIV::var set| ⟹ 
- length es = length xs ⟹ 
+lemma card_SSupp_mkSubst_rrename_inv:
+"bij (σ::var⇒var) ⟹ |supp σ| <o |UNIV::var set| ⟹
+ length es = length xs ⟹
  |SSupp (rrename σ ∘ mkSubst xs es ∘ inv σ)| <o |UNIV::var set|"
 by (metis SSupp_mkSubst mkSubst_map_rrename_inv)
 
-lemma mkSubst_smap: "bij f ⟹ distinct xs ⟹ z ∈ set xs ⟹ 
- length es = length xs ⟹ 
+lemma mkSubst_smap: "bij f ⟹ distinct xs ⟹ z ∈ set xs ⟹
+ length es = length xs ⟹
  mkSubst (map f xs) es (f z) = mkSubst xs es z"
-by (metis bij_distinct_smap distinct_Ex1 length_map mkSubst_nth nth_map) 
+by (metis bij_distinct_smap distinct_Ex1 length_map mkSubst_nth nth_map)
 
 
 (* *)
 
 lemma Lm_eq_tvsubst: 
-assumes il: "Lm (x::var) e1 = Lm x' e1'"
+assumes il: "Lm (x::var) e1 = Lm x' e1'"
 shows "tvsubst (Vr (x:=e2)) e1 = tvsubst (Vr (x':=e2)) e1'"
 proof-
-  obtain f where f: "bij f" "|supp f| <o |UNIV::var set|" "id_on (FFVars (Lm x e1)) f" 
-  and 0: "x' = f x" "e1' = rrename f e1" using il[unfolded Lm_inject] by auto
-  show ?thesis unfolding 0 apply(subst rrename_eq_tvsubst_Vr')
+  obtain f where f: "bij f" "|supp f| <o |UNIV::var set|" "id_on (FFVars (Lm x e1)) f" 
+  and 0: "x' = f x" "e1' = rrename f e1" using il[unfolded Lm_inject] by auto
+  show ?thesis unfolding 0 apply(subst rrename_eq_tvsubst_Vr')
     subgoal by fact subgoal by fact
     subgoal apply(subst tvsubst_comp)
       subgoal by simp
-      subgoal using f(2) by auto
+      subgoal using f(2) by auto
       subgoal apply(rule tvsubst_cong)
         subgoal by simp
-        subgoal by (simp add: SSupp_tvsubst_bound f(2))
-        subgoal apply simp 
-     subgoal using f(1) f(3) id_onD by fastforce . . . .
+        subgoal by (simp add: SSupp_tvsubst_bound f(2))
+        subgoal apply simp
+     subgoal using f(1) f(3) id_onD by fastforce . . . .
 qed
 
 
-
-
 (* RECURSOR PREPARATIONS: *)
 
 thm Lm_inject[no_vars]
 
-lemma Lm_inject_strong:
+lemma Lm_inject_strong:
 assumes "Lm (x::var) e = Lm x' e'"
 shows "∃f. bij f ∧ |supp f| <o |UNIV::var set| ∧  
    id_on (- {x,x'}) f ∧ id_on (FFVars (Lm x e)) f ∧
    f x = x' ∧ rrename f e = e'" 
 apply(rule exI[of _ "id(x := x', x' := x)"])
-using assms unfolding Lm_inject_swap apply safe
+using assms unfolding Lm_inject_swap apply safe
 unfolding id_on_def by auto (metis fun_upd_twist)
 
 
 lemma Lm_inject_strong':
-assumes il: "Lm (x::var) e = Lm x' e'" and z: "z ∉ FFVars (Lm x e) ∪ FFVars (Lm x' e')"
+assumes il: "Lm (x::var) e = Lm x' e'" and z: "z ∉ FFVars (Lm x e) ∪ FFVars (Lm x' e')"
 shows 
 "∃f f'. 
    bij f ∧ |supp f| <o |UNIV::var set| ∧ id_on (- {x,z}) f ∧ id_on (FFVars (Lm x e)) f ∧ f x = z ∧ 
    bij f' ∧ |supp f'| <o |UNIV::var set| ∧ id_on (- {x',z}) f' ∧ id_on (FFVars (Lm x' e')) f' ∧ f' x' = z ∧ 
    rrename f e = rrename f' e'"
 proof-
-  define f where "f = id(x := z, z := x)"
-  have f: "bij f ∧ |supp f| <o |UNIV::var set| ∧ id_on (- {x,z}) f ∧ id_on (FFVars (Lm x e)) f ∧ f x = z"
-  using z unfolding f_def id_on_def by auto
-  define f' where "f' = id(x' := z, z := x')"
-  have f': "bij f' ∧ |supp f'| <o |UNIV::var set| ∧ id_on (- {x',z}) f' ∧ id_on (FFVars (Lm x' e')) f' ∧ f' x' = z"
-  using z unfolding f'_def id_on_def by auto
+  define f where "f = id(x := z, z := x)"
+  have f: "bij f ∧ |supp f| <o |UNIV::var set| ∧ id_on (- {x,z}) f ∧ id_on (FFVars (Lm x e)) f ∧ f x = z"
+  using z unfolding f_def id_on_def by auto
+  define f' where "f' = id(x' := z, z := x')"
+  have f': "bij f' ∧ |supp f'| <o |UNIV::var set| ∧ id_on (- {x',z}) f' ∧ id_on (FFVars (Lm x' e')) f' ∧ f' x' = z"
+  using z unfolding f'_def id_on_def by auto
  
-  obtain g where g: "bij g ∧ |supp g| <o |UNIV::var set| ∧ id_on (FFVars (Lm x e)) g ∧ g x = x'" and ge: "e' = rrename g e"
-  using il unfolding Lm_inject by auto
+  obtain g where g: "bij g ∧ |supp g| <o |UNIV::var set| ∧ id_on (FFVars (Lm x e)) g ∧ g x = x'" and ge: "e' = rrename g e"
+  using il unfolding Lm_inject by auto
 
-  have ff': "rrename f e = rrename f' e'" 
-  unfolding f_def f'_def ge unfolding f_def f'_def using g apply(subst ltermP.rrename_comps)
+  have ff': "rrename f e = rrename f' e'" 
+  unfolding f_def f'_def ge unfolding f_def f'_def using g apply(subst ltermP.rrename_comps)
     subgoal by auto  subgoal by auto subgoal by auto subgoal by auto
-    subgoal apply(rule rrename_cong) using g
+    subgoal apply(rule rrename_cong) using g
       subgoal by auto  subgoal by auto subgoal by auto 
       subgoal using ltermP_pre.supp_comp_bound by auto
-      subgoal using ltermP_pre.supp_comp_bound z unfolding id_on_def by auto . .
+      subgoal using ltermP_pre.supp_comp_bound z unfolding id_on_def by auto . .
 
   show ?thesis
   apply(rule exI[of _ f]) apply(rule exI[of _ f'])
-  using f f' ff' by auto
+  using f f' ff' by auto
 qed
 
 lemma lterm_rrename_induct[case_names Vr Ap Lm]:
-assumes VVr: "⋀x. P (Vr (x::var))"
-and AAp: "⋀e1 e2. P e1 ⟹ P e2 ⟹ P (Ap e1 e2)" 
-and LLm: "⋀x e. (⋀f. bij f ⟹ |supp f| <o |UNIV::var set| ⟹ P (rrename f e)) ⟹ P (Lm x e)"
+assumes VVr: "⋀x. P (Vr (x::var))"
+and AAp: "⋀e1 e2. P e1 ⟹ P e2 ⟹ P (Ap e1 e2)" 
+and LLm: "⋀x e. (⋀f. bij f ⟹ |supp f| <o |UNIV::var set| ⟹ P (rrename f e)) ⟹ P (Lm x e)"
 shows "P t"
 proof-
   have "∀f. bij f ∧ |supp f| <o |UNIV::var set| ⟶ P (rrename f t)"
   proof(induct)
     case (Vr x)
-    then show ?case using VVr by auto
+    then show ?case using VVr by auto
   next
     case (Ap t1 t2)
-    then show ?case using AAp by auto
+    then show ?case using AAp by auto
   next
     case (Lm x t)
-    then show ?case using LLm
+    then show ?case using LLm
       by simp (metis bij_o ltermP.rrename_comps ltermP_pre.supp_comp_bound)
   qed
   thus ?thesis apply(elim allE[of _ id]) by auto
@@ -863,14 +908,14 @@ 
Theory LC

 
 (* RECURSOR *)
 
-locale LC_Rec = 
+locale LC_Rec =
 fixes B :: "'b set"
 and VrB :: "var ⇒ 'b" 
 and ApB :: "'b ⇒ 'b ⇒ 'b"
 and LmB :: "var ⇒ 'b ⇒ 'b"
 and renB :: "(var ⇒ var) ⇒ 'b ⇒ 'b"
 and FVarsB :: "'b ⇒ var set"
-assumes 
+assumes
 (* closedness: *)
 VrB_B[simp,intro]: "⋀x. VrB x ∈ B"
 and 
@@ -879,74 +924,74 @@ 
Theory LC

 LmB_B[simp,intro]: "⋀x b. b ∈  B ⟹ LmB x b ∈ B"
 and 
 renB_B[simp]: "⋀σ b. bij σ ⟹ |supp σ| <o |UNIV::var set| ⟹ b ∈ B ⟹ renB σ b ∈ B"
-and 
+and
 (* proper axioms: *)
 renB_id[simp,intro]: "⋀b. b ∈ B ⟹ renB id b = b"
-and 
-renB_comp[simp,intro]: "⋀b σ τ. bij σ ⟹ |supp σ| <o |UNIV::var set| ⟹ 
+and
+renB_comp[simp,intro]: "⋀b σ τ. bij σ ⟹ |supp σ| <o |UNIV::var set| ⟹
     bij τ ⟹ |supp τ| <o |UNIV::var set| ⟹ b ∈ B ⟹ renB (τ o σ) b = renB τ (renB σ b)"
-and 
-renB_cong[simp]: "⋀σ b. bij σ ⟹ |supp σ| <o |UNIV::var set| ⟹ 
-   (∀x ∈ FVarsB b. σ x = x) ⟹ 
+and
+renB_cong[simp]: "⋀σ b. bij σ ⟹ |supp σ| <o |UNIV::var set| ⟹
+   (∀x ∈ FVarsB b. σ x = x) ⟹
    renB σ b = b"
-(* and 
-NB: This is redundant:  
-renB_FVarsB[simp]: "⋀σ x b. bij σ ⟹ |supp σ| <o |UNIV::var set| ⟹ 
+(* and
+NB: This is redundant:
+renB_FVarsB[simp]: "⋀σ x b. bij σ ⟹ |supp σ| <o |UNIV::var set| ⟹
    x ∈ FVarsB (renB σ b) ⟷ inv σ x ∈ FVarsB b"
 *)
-and 
+and
 (* *)
 renB_VrB[simp]: "⋀σ x. bij σ ⟹ |supp σ| <o |UNIV::var set| ⟹ renB σ (VrB x) = VrB (σ x)"
 and 
-renB_ApB[simp]: "⋀σ b1 b2. bij σ ⟹ |supp σ| <o |UNIV::var set| ⟹ {b1,b2} ⊆ B ⟹ 
+renB_ApB[simp]: "⋀σ b1 b2. bij σ ⟹ |supp σ| <o |UNIV::var set| ⟹ {b1,b2} ⊆ B ⟹ 
    renB σ (ApB b1 b2) = ApB (renB σ b1) (renB σ b2)"
 and 
-renB_LmB[simp]: "⋀σ x b. bij σ ⟹ |supp σ| <o |UNIV::var set| ⟹ b ∈ B ⟹ 
+renB_LmB[simp]: "⋀σ x b. bij σ ⟹ |supp σ| <o |UNIV::var set| ⟹ b ∈ B ⟹ 
    renB σ (LmB x b) = LmB (σ x) (renB σ b)"
 (* *)
 and 
-FVarsB_VrB: "⋀x. FVarsB (VrB x) ⊆ {x}"
+FVarsB_VrB: "⋀x. FVarsB (VrB x) ⊆ {x}"
 and 
-FVarsB_ApB: "⋀b1 b2. {b1,b2} ⊆ B ⟹ FVarsB (ApB b1 b2) ⊆ FVarsB b1 ∪ FVarsB b2"
+FVarsB_ApB: "⋀b1 b2. {b1,b2} ⊆ B ⟹ FVarsB (ApB b1 b2) ⊆ FVarsB b1 ∪ FVarsB b2"
 and 
-FVarsB_LmB: "⋀x b. b ∈ B ⟹ FVarsB (LmB x b) ⊆ FVarsB b - {x}"
+FVarsB_LmB: "⋀x b. b ∈ B ⟹ FVarsB (LmB x b) ⊆ FVarsB b - {x}"
 begin 
 
 lemma not_in_FVarsB_LmB: "b ∈ B ⟹ x ∉ FVarsB (LmB x b)"
-using FVarsB_LmB by auto
+using FVarsB_LmB by auto
 
-lemma LmB_inject_strong_rev: 
-assumes bb': "{b,b'} ⊆ B" and 
-x': "x' = x ∨ x' ∉ FVarsB b" and 
-f: "bij f" "|supp f| <o |UNIV::var set|" 
-"id_on (- {x, x'}) f" "f x = x'" and r: "renB f b = b'"
+lemma LmB_inject_strong_rev: 
+assumes bb': "{b,b'} ⊆ B" and 
+x': "x' = x ∨ x' ∉ FVarsB b" and 
+f: "bij f" "|supp f| <o |UNIV::var set|" 
+"id_on (- {x, x'}) f" "f x = x'" and r: "renB f b = b'"
 shows "LmB x b = LmB x' b'"
 proof-
-  have id: "id_on (FVarsB (LmB x b)) f"
-  using f FVarsB_LmB bb' x' unfolding id_on_def by auto
+  have id: "id_on (FVarsB (LmB x b)) f"
+  using f FVarsB_LmB bb' x' unfolding id_on_def by auto
   have "LmB x b = renB f (LmB x b)"
-  apply(rule sym) apply(rule renB_cong) using f bb' FVarsB_LmB unfolding id_on_def 
-  using id unfolding id_on_def by auto
-  also have "… = LmB x' b'" apply(subst renB_LmB) using f r bb' by auto
+  apply(rule sym) apply(rule renB_cong) using f bb' FVarsB_LmB unfolding id_on_def 
+  using id unfolding id_on_def by auto
+  also have "… = LmB x' b'" apply(subst renB_LmB) using f r bb' by auto
   finally show ?thesis .
 qed
 
-lemma LmB_inject_strong'_rev: 
+lemma LmB_inject_strong'_rev: 
 assumes bb': "{b,b'} ⊆ B"  
 and z: "z = x ∨ z ∉ FVarsB b" "z = x' ∨ z ∉ FVarsB b'"
-and f: "bij f" "|supp f| <o |UNIV::var set|" "id_on (- {x, z}) f" "f x = z" 
-and f': "bij f'" "|supp f'| <o |UNIV::var set|" "id_on (- {x', z}) f'" "f' x' = z" 
-and r: "renB f b = renB f' b'"
+and f: "bij f" "|supp f| <o |UNIV::var set|" "id_on (- {x, z}) f" "f x = z"
+and f': "bij f'" "|supp f'| <o |UNIV::var set|" "id_on (- {x', z}) f'" "f' x' = z"
+and r: "renB f b = renB f' b'"
 shows "LmB x b = LmB x' b'" 
 proof-
-  define c where c: "c = renB f b"
-  have c': "c = renB f' b'" unfolding c r ..
+  define c where c: "c = renB f b"
+  have c': "c = renB f' b'" unfolding c r ..
   have "LmB x b = LmB z c"  
-  apply(rule LmB_inject_strong_rev[of _ _ _ _ f]) 
-  using assms FVarsB_LmB id_on_def unfolding c by auto
+  apply(rule LmB_inject_strong_rev[of _ _ _ _ f]) 
+  using assms FVarsB_LmB id_on_def unfolding c by auto
   also have "LmB z c = LmB x' b'"  
-  apply(rule sym, rule LmB_inject_strong_rev[of _ _ _ _ f']) 
-  using assms FVarsB_LmB id_on_def unfolding c by auto
+  apply(rule sym, rule LmB_inject_strong_rev[of _ _ _ _ f']) 
+  using assms FVarsB_LmB id_on_def unfolding c by auto
   finally show ?thesis .
 qed
 
@@ -955,7 +1000,7 @@ 
Theory LC

 and an even more general one if we replace it with LmB_inject_strong'_rev. 
 *)
 
-definition morFromTrm where 
+definition morFromTrm where 
 "morFromTrm H ≡ 
  (∀e. H e ∈ B) ∧  
  (∀x. H (Vr x) = VrB x) ∧ 
@@ -966,159 +1011,159 @@ 
Theory LC

 
 (* *)
 
-inductive R where 
-Vr: "R (Vr x) (VrB x)"
+inductive R where 
+Vr: "R (Vr x) (VrB x)"
 |
-Ap: "R e1 b1 ⟹ R e2 b2 ⟹ R (Ap e1 e2) (ApB b1 b2)"
+Ap: "R e1 b1 ⟹ R e2 b2 ⟹ R (Ap e1 e2) (ApB b1 b2)"
 |
-Lm: "R e b ⟹ R (Lm x e) (LmB x b)"
+Lm: "R e b ⟹ R (Lm x e) (LmB x b)"
 
 (* *)
 
-lemma R_Vr_elim[simp]: "R (Vr x) b ⟷ b = VrB x"
+lemma R_Vr_elim[simp]: "R (Vr x) b ⟷ b = VrB x"
 apply safe
-  subgoal using R.cases by fastforce
-  subgoal by (auto intro: R.intros) .
-
-lemma R_Ap_elim: 
-assumes "R (Ap e1 e2) b"
-shows "∃b1 b2. R e1 b1 ∧ R e2 b2 ∧ b = ApB b1 b2"
-by (metis Ap_inject R.simps assms ltermP.distinct(1) ltermP.distinct(4))
-
-lemma R_Lm_elim: 
-assumes "R (Lm x e) b"
-shows "∃x' e' b'. R e' b' ∧ Lm x e = Lm x' e' ∧ b = LmB x' b'"
-using assms by (cases rule: R.cases) auto
-
-lemma R_total: 
-"∃b. R e b"
-apply(induct e) by (auto intro: R.intros)
-
-lemma R_B: 
-"R e b ⟹ b ∈ B"
-apply(induct rule: R.induct) by auto
-
-lemma R_main: 
-"(∀b b'. R e b ⟶ R e b' ⟶ b = b') ∧ 
- (∀b. R e b ⟶ FVarsB b ⊆ FFVars e) ∧ 
- (∀b f. R e b ∧ bij f ∧ |supp f| <o |UNIV::var set|
-        ⟶ R (rrename f e) (renB f b))"
+  subgoal using R.cases by fastforce
+  subgoal by (auto intro: R.intros) .
+
+lemma R_Ap_elim: 
+assumes "R (Ap e1 e2) b"
+shows "∃b1 b2. R e1 b1 ∧ R e2 b2 ∧ b = ApB b1 b2"
+by (metis Ap_inject R.simps assms ltermP.distinct(1) ltermP.distinct(4))
+
+lemma R_Lm_elim: 
+assumes "R (Lm x e) b"
+shows "∃x' e' b'. R e' b' ∧ Lm x e = Lm x' e' ∧ b = LmB x' b'"
+using assms by (cases rule: R.cases) auto
+
+lemma R_total:
+"∃b. R e b"
+apply(induct e) by (auto intro: R.intros)
+
+lemma R_B:
+"R e b ⟹ b ∈ B"
+apply(induct rule: R.induct) by auto
+
+lemma R_main:
+"(∀b b'. R e b ⟶ R e b' ⟶ b = b') ∧
+ (∀b. R e b ⟶ FVarsB b ⊆ FFVars e) ∧
+ (∀b f. R e b ∧ bij f ∧ |supp f| <o |UNIV::var set|
+        ⟶ R (rrename f e) (renB f b))"
 proof(induct e rule: lterm_rrename_induct)
   case (Vr x)
-  then show ?case using FVarsB_VrB by auto
+  then show ?case using FVarsB_VrB by auto
 next
   case (Ap e1 e2)
   then show ?case apply safe 
-    subgoal by (metis R_Ap_elim)
-    subgoal by simp (smt (verit, del_insts) FVarsB_ApB R_Ap_elim 
-      R_B Un_iff bot.extremum insert_Diff insert_subset)
-    subgoal apply(drule R_Ap_elim) 
-      by (smt (verit, del_insts) R.simps R_B bot.extremum insert_subset renB_ApB 
-      rrename_simps(2)) .
+    subgoal by (metis R_Ap_elim)
+    subgoal by simp (smt (verit, del_insts) FVarsB_ApB R_Ap_elim 
+      R_B Un_iff bot.extremum insert_Diff insert_subset)
+    subgoal apply(drule R_Ap_elim) 
+      by (smt (verit, del_insts) R.simps R_B bot.extremum insert_subset renB_ApB 
+      ltermP.permute(2)) .
 next
-  case (Lm x t)
-  note Lmm = Lm[rule_format]
-  note Lm1 = Lmm[THEN conjunct1, rule_format]
-  note Lm2 = Lmm[THEN conjunct2, THEN conjunct1, rule_format]
-  note Lm3 = Lmm[THEN conjunct2, THEN conjunct2, rule_format, OF _ _ conjI, OF _ _ _ conjI]
-  note Lm33 = Lm3[of id, simplified]
+  case (Lm x t)
+  note Lmm = Lm[rule_format]
+  note Lm1 = Lmm[THEN conjunct1, rule_format]
+  note Lm2 = Lmm[THEN conjunct2, THEN conjunct1, rule_format]
+  note Lm3 = Lmm[THEN conjunct2, THEN conjunct2, rule_format, OF _ _ conjI, OF _ _ _ conjI]
+  note Lm33 = Lm3[of id, simplified]
 
   show ?case proof safe
-    fix b1 b2 assume RLm: "R (Lm x t) b1" "R (Lm x t) b2" 
+    fix b1 b2 assume RLm: "R (Lm x t) b1" "R (Lm x t) b2" 
     then obtain x1' t1' b1' x2' t2' b2'
-    where 1: "R t1' b1'" "Lm x t = Lm x1' t1'" "b1 = LmB x1' b1'"
-    and   2: "R t2' b2'" "Lm x t = Lm x2' t2'" "b2 = LmB x2' b2'"
-    using R_Lm_elim by metis
+    where 1: "R t1' b1'" "Lm x t = Lm x1' t1'" "b1 = LmB x1' b1'"
+    and   2: "R t2' b2'" "Lm x t = Lm x2' t2'" "b2 = LmB x2' b2'"
+    using R_Lm_elim by metis
 
-    have b12': "{b1',b2'} ⊆ B"
-    using 1(1,3) 2(1,3) R_B by auto
+    have b12': "{b1',b2'} ⊆ B"
+    using 1(1,3) 2(1,3) R_B by auto
 
     have "|{x,x1',x2'} ∪ FFVars t ∪ FFVars t1' ∪ FFVars t2'| <o |UNIV::var set|"
     by (metis Un_insert_right singl_bound sup_bot_right ltermP.set_bd_UNIV var_ltermP_pre_class.Un_bound)
-    then obtain z where z: 
+    then obtain z where z: 
     "z ∉ {x,x1',x2'} ∪ FFVars t ∪ FFVars t1' ∪ FFVars t2'" 
     by (meson exists_fresh)
 
-    obtain f1 f1' where 
-    f1: "bij f1" "|supp f1| <o |UNIV::var set|"
+    obtain f1 f1' where
+    f1: "bij f1" "|supp f1| <o |UNIV::var set|"
        "id_on (- {x, z}) f1 ∧ id_on (FFVars (Lm x t)) f1" and 
-    f1': "bij f1'" "|supp f1'| <o |UNIV::var set|"
+    f1': "bij f1'" "|supp f1'| <o |UNIV::var set|"
        "id_on (- {x1', z}) f1' ∧ id_on (FFVars (Lm x1' t1')) f1'"
-    and z1: "f1 x = z" "f1' x1' = z"  
-    and f1f1': "rrename f1 t = rrename f1' t1'"   
-    using z Lm_inject_strong'[OF 1(2), of z] by auto
+    and z1: "f1 x = z" "f1' x1' = z"  
+    and f1f1': "rrename f1 t = rrename f1' t1'"   
+    using z Lm_inject_strong'[OF 1(2), of z] by auto
 
-    have if1': "bij (inv f1' o f1)" "|supp (inv f1' o f1)| <o |UNIV::var set|"
-    by (auto simp add: f1 f1' ltermP_pre.supp_comp_bound)
+    have if1': "bij (inv f1' o f1)" "|supp (inv f1' o f1)| <o |UNIV::var set|"
+    by (auto simp add: f1 f1' ltermP_pre.supp_comp_bound)
 
-    have t1': "t1' = rrename (inv f1' o f1) t"  
-    using f1f1' by (metis (mono_tags, lifting) bij_imp_bij_inv f1 f1' 
+    have t1': "t1' = rrename (inv f1' o f1) t"  
+    using f1f1' by (metis (mono_tags, lifting) bij_imp_bij_inv f1 f1' 
        inv_o_simp1 supp_inv_bound ltermP.rrename_comps ltermP.rrename_ids)
 
-    have fvb1': "FVarsB b1' ⊆ FFVars t1'"
-    using Lm2[OF if1', unfolded t1'[symmetric], OF 1(1)] .
+    have fvb1': "FVarsB b1' ⊆ FFVars t1'"
+    using Lm2[OF if1', unfolded t1'[symmetric], OF 1(1)] .
 
-    obtain f2 f2' where 
-    f2: "bij f2" "|supp f2| <o |UNIV::var set|"
+    obtain f2 f2' where
+    f2: "bij f2" "|supp f2| <o |UNIV::var set|"
       "id_on (- {x, z}) f2 ∧ id_on (FFVars (Lm x t)) f2" and 
-    f2': "bij f2'" "|supp f2'| <o |UNIV::var set|"
+    f2': "bij f2'" "|supp f2'| <o |UNIV::var set|"
       "id_on (- {x2', z}) f2' ∧ id_on (FFVars (Lm x2' t2')) f2'"
-    and z2: "f2 x = z" "f2' x2' = z"  
-    and f2f2': "rrename f2 t = rrename f2' t2'"   
-    using z Lm_inject_strong'[OF 2(2), of z] by auto
+    and z2: "f2 x = z" "f2' x2' = z"  
+    and f2f2': "rrename f2 t = rrename f2' t2'"   
+    using z Lm_inject_strong'[OF 2(2), of z] by auto
 
-    have if2': "bij (inv f2' o f2)" "|supp (inv f2' o f2)| <o |UNIV::var set|"
-    by (auto simp add: f2 f2' ltermP_pre.supp_comp_bound)
+    have if2': "bij (inv f2' o f2)" "|supp (inv f2' o f2)| <o |UNIV::var set|"
+    by (auto simp add: f2 f2' ltermP_pre.supp_comp_bound)
 
-    have t2': "t2' = rrename (inv f2' o f2) t" 
-    using f2f2' by (metis (mono_tags, lifting) bij_imp_bij_inv f2 f2' 
+    have t2': "t2' = rrename (inv f2' o f2) t" 
+    using f2f2' by (metis (mono_tags, lifting) bij_imp_bij_inv f2 f2' 
       inv_o_simp1 supp_inv_bound ltermP.rrename_comps ltermP.rrename_ids)
 
-    have fvb2': "FVarsB b2' ⊆ FFVars t2'"
-    using Lm2[OF if2', unfolded t2'[symmetric], OF 2(1)] .
+    have fvb2': "FVarsB b2' ⊆ FFVars t2'"
+    using Lm2[OF if2', unfolded t2'[symmetric], OF 2(1)] .
 
-    define ff2' where "ff2' = f1 o (inv f2) o f2'"
+    define ff2' where "ff2' = f1 o (inv f2) o f2'"
 
-    have ff2': "bij ff2'" "|supp ff2'| <o |UNIV::var set|"
+    have ff2': "bij ff2'" "|supp ff2'| <o |UNIV::var set|"
        "id_on (- {x2', z}) ff2' ∧ id_on (FFVars (Lm x2' t2')) ff2'" 
-    unfolding ff2'_def using f1 f2 f2'  
+    unfolding ff2'_def using f1 f2 f2'  
       subgoal by auto 
-      subgoal unfolding ff2'_def using f1 f2 f2' by (simp add: ltermP_pre.supp_comp_bound)
-      subgoal unfolding ff2'_def using f1 f2 f2' unfolding id_on_def by simp (metis inv_simp1 z1(1) z2(1)) .
+      subgoal unfolding ff2'_def using f1 f2 f2' by (simp add: ltermP_pre.supp_comp_bound)
+      subgoal unfolding ff2'_def using f1 f2 f2' unfolding id_on_def by simp (metis inv_simp1 z1(1) z2(1)) .
 
-    have zz2: "ff2' x2' = z"
-    by (metis comp_def f2 ff2'_def inv_simp1 z1(1) z2(1) z2(2))
- 
-    have rew1: "rrename f1' (rrename (inv f1' ∘ f1) t) = rrename f1 t" 
-    using f1f1' t1' by auto
+    have zz2: "ff2' x2' = z"
+    by (metis comp_def f2 ff2'_def inv_simp1 z1(1) z2(1) z2(2))
+
+    have rew1: "rrename f1' (rrename (inv f1' ∘ f1) t) = rrename f1 t"
+    using f1f1' t1' by auto
 
-    have rew2: "rrename ff2' (rrename (inv f2' ∘ f2) t) = rrename f1 t" 
-    by (smt (verit, del_insts) bij_betw_imp_inj_on bij_imp_bij_inv bij_o f1(1) f1(2) f2'(1) f2'(2) f2(1) f2(2) f2f2' ff2'_def o_inv_o_cancel supp_inv_bound ltermP.rrename_comps ltermP_pre.supp_comp_bound)
+    have rew2: "rrename ff2' (rrename (inv f2' ∘ f2) t) = rrename f1 t" 
+    by (smt (verit, del_insts) bij_betw_imp_inj_on bij_imp_bij_inv bij_o f1(1) f1(2) f2'(1) f2'(2) f2(1) f2(2) f2f2' ff2'_def o_inv_o_cancel supp_inv_bound ltermP.rrename_comps ltermP_pre.supp_comp_bound)
  
-    show "b1 = b2" unfolding 1(3) 2(3) 
-    apply(rule LmB_inject_strong'_rev[OF b12', of z _ _ f1' ff2'])
-      subgoal using z fvb1' by auto
-      subgoal using z fvb2' by auto
-      subgoal using f1' by auto  subgoal using f1' by auto
-      subgoal using f1' by auto  subgoal using z1 by auto
-      subgoal using ff2' by auto  subgoal using ff2' by auto
-      subgoal using ff2' by auto  subgoal using zz2 by auto 
-      subgoal apply(rule Lm1[OF f1(1,2)])  
-        subgoal using Lm3[OF if1' 1(1)[unfolded t1'] f1'(1,2), unfolded rew1] .
-        subgoal using Lm3[OF if2' 2(1)[unfolded t2'] ff2'(1,2), unfolded rew2] . . .
+    show "b1 = b2" unfolding 1(3) 2(3) 
+    apply(rule LmB_inject_strong'_rev[OF b12', of z _ _ f1' ff2'])
+      subgoal using z fvb1' by auto
+      subgoal using z fvb2' by auto
+      subgoal using f1' by auto  subgoal using f1' by auto
+      subgoal using f1' by auto  subgoal using z1 by auto
+      subgoal using ff2' by auto  subgoal using ff2' by auto
+      subgoal using ff2' by auto  subgoal using zz2 by auto 
+      subgoal apply(rule Lm1[OF f1(1,2)])  
+        subgoal using Lm3[OF if1' 1(1)[unfolded t1'] f1'(1,2), unfolded rew1] .
+        subgoal using Lm3[OF if2' 2(1)[unfolded t2'] ff2'(1,2), unfolded rew2] . . .
   (* *)
   next
     fix b y 
-    assume R: "R (Lm x t) b" and yy: "y ∈ FVarsB b"
+    assume R: "R (Lm x t) b" and yy: "y ∈ FVarsB b"
     then obtain x' t' b'
-    where 0: "R t' b'" "Lm x t = Lm x' t'" "b = LmB x' b'" 
-    using R_Lm_elim by metis
+    where 0: "R t' b'" "Lm x t = Lm x' t'" "b = LmB x' b'" 
+    using R_Lm_elim by metis
 
-    have b': "b' ∈  B"
-    using 0(1,3) R_B by auto
+    have b': "b' ∈  B"
+    using 0(1,3) R_B by auto
 
-    have y: "y ≠ x'" "y ∈ FVarsB b'" using b' yy unfolding 0 
-    using FVarsB_LmB[OF b'] by auto
+    have y: "y ≠ x'" "y ∈ FVarsB b'" using b' yy unfolding 0 
+    using FVarsB_LmB[OF b'] by auto
 
     have "|{x,x'} ∪ FFVars t ∪ FFVars t'| <o |UNIV::var set|"
     by (metis Un_insert_right singl_bound sup_bot_right ltermP.set_bd_UNIV var_ltermP_pre_class.Un_bound)
@@ -1126,32 +1171,32 @@ 
Theory LC

     "z ∉ {x,x'} ∪ FFVars t ∪ FFVars t'" 
     by (meson exists_fresh)
 
-    obtain f where 
-    f: "bij f" "|supp f| <o |UNIV::var set|"
+    obtain f where
+    f: "bij f" "|supp f| <o |UNIV::var set|"
        "id_on (- {x, x'}) f ∧ id_on (FFVars (Lm x t)) f" 
     and z: "f x = x'"   
-    and t': "t' = rrename f t" 
-    using  Lm_inject_strong[OF 0(2)] by auto
+    and t': "t' = rrename f t" 
+    using  Lm_inject_strong[OF 0(2)] by auto
     
-    have fvb't': "FVarsB b' ⊆ FFVars t'"
-    using Lm2[OF f(1,2), unfolded t'[symmetric], OF 0(1)] .
-    have yt': "y ∈ FFVars t'" using fvb't' y(2) by auto
+    have fvb't': "FVarsB b' ⊆ FFVars t'"
+    using Lm2[OF f(1,2), unfolded t'[symmetric], OF 0(1)] .
+    have yt': "y ∈ FFVars t'" using fvb't' y(2) by auto
 
-    show "y ∈ FFVars (Lm x t)" using yt' y unfolding 0(2) by auto
+    show "y ∈ FFVars (Lm x t)" using yt' y unfolding 0(2) by auto
   (* *)
   next
     fix b and f :: "var⇒var"
 
-    assume "R (Lm x t) b" and f: "bij f" "|supp f| <o |UNIV::var set|"
+    assume "R (Lm x t) b" and f: "bij f" "|supp f| <o |UNIV::var set|"
+
 
-   
     then obtain x' t' b'
-    where 0: "R t' b'" "Lm x t = Lm x' t'" "b = LmB x' b'" 
-    using R_Lm_elim by metis
+    where 0: "R t' b'" "Lm x t = Lm x' t'" "b = LmB x' b'" 
+    using R_Lm_elim by metis
 
 
-    have b': "b' ∈  B"
-    using 0(1,3) R_B by auto
+    have b': "b' ∈  B"
+    using 0(1,3) R_B by auto
 
     have "|{x,x'} ∪ FFVars t ∪ FFVars t'| <o |UNIV::var set|"
     by (metis Un_insert_right singl_bound sup_bot_right ltermP.set_bd_UNIV var_ltermP_pre_class.Un_bound)
@@ -1159,84 +1204,86 @@ 
Theory LC

     "z ∉ {x,x'} ∪ FFVars t ∪ FFVars t'" 
     by (meson exists_fresh)
 
-    obtain g where 
+    obtain g where
     g: "bij g" "|supp g| <o |UNIV::var set|"
        "id_on (- {x, x'}) g ∧ id_on (FFVars (Lm x t)) g" 
     and z: "g x = x'"   
-    and t': "t' = rrename g t" 
-    using Lm_inject_strong[OF 0(2)] by auto
+    and t': "t' = rrename g t" 
+    using Lm_inject_strong[OF 0(2)] by auto
 
-    have RR: "R (Lm (f x') (rrename f t')) (LmB (f x') (renB f b'))"
-    apply(rule R.Lm) unfolding t' apply(rule Lm3)
+    have RR: "R (Lm (f x') (rrename f t')) (LmB (f x') (renB f b'))"
+    apply(rule R.Lm) unfolding t' apply(rule Lm3)
       subgoal by fact  subgoal by fact
-      subgoal using 0(1) unfolding t' .
+      subgoal using 0(1) unfolding t' .
       subgoal by fact subgoal by fact .
 
-    show "R (rrename f (Lm x t)) (renB f b)" 
-    unfolding 0 using RR apply(subst rrename_simps) 
-      subgoal using f by auto subgoal using f by auto
-      subgoal apply(subst renB_LmB)
-       using f b' by auto .  
+    show "R (rrename f (Lm x t)) (renB f b)" 
+    unfolding 0 using RR apply(subst ltermP.permute) 
+      subgoal using f by auto subgoal using f by auto
+      subgoal apply(subst renB_LmB)
+       using f b' by auto .  
   qed
 qed
 
-lemmas R_functional = R_main[THEN conjunct1]
-lemmas R_FFVars = R_main[THEN conjunct2, THEN conjunct1]
-lemmas R_subst = R_main[THEN conjunct2, THEN conjunct2]
+lemmas R_functional = R_main[THEN conjunct1]
+lemmas R_FFVars = R_main[THEN conjunct2, THEN conjunct1]
+lemmas R_subst = R_main[THEN conjunct2, THEN conjunct2]
 
-definition H :: "lterm ⇒ 'b" where "H t ≡ SOME d. R t d"
+definition H :: "lterm ⇒ 'b" where "H t ≡ SOME d. R t d"
 
-lemma R_F: "R t (H t)"
-by (simp add: R_total H_def someI_ex)
+lemma R_F: "R t (H t)"
+by (simp add: R_total H_def someI_ex)
 
-lemma ex_morFromTrm: "∃H. morFromTrm H"
-apply(rule exI[of _ H]) unfolding morFromTrm_def apply(intro conjI)
-  subgoal using R_B R_F by auto
-  subgoal using R.Vr R_F R_functional by blast
-  subgoal using R.Ap R_F R_functional by blast
-  subgoal using R.Lm R_F R_functional by blast
-  subgoal by (meson R_F R_functional R_subst)
-  subgoal by (simp add: R_F R_FFVars) .
+lemma ex_morFromTrm: "∃H. morFromTrm H"
+apply(rule exI[of _ H]) unfolding morFromTrm_def apply(intro conjI)
+  subgoal using R_B R_F by auto
+  subgoal using R.Vr R_F R_functional by blast
+  subgoal using R.Ap R_F R_functional by blast
+  subgoal using R.Lm R_F R_functional by blast
+  subgoal by (meson R_F R_functional R_subst)
+  subgoal by (simp add: R_F R_FFVars) .
 
-definition rec where "rec ≡ SOME H. morFromTrm H"
+definition rec where "rec ≡ SOME H. morFromTrm H"
 
-lemma morFromTrm_rec: "morFromTrm rec"
-by (metis ex_morFromTrm rec_def someI_ex)
+lemma morFromTrm_rec: "morFromTrm rec"
+by (metis ex_morFromTrm rec_def someI_ex)
 
-lemma rec_B[simp,intro!]: "rec e ∈ B"
-using morFromTrm_rec unfolding morFromTrm_def by auto
+lemma rec_B[simp,intro!]: "rec e ∈ B"
+using morFromTrm_rec unfolding morFromTrm_def by auto
 
-lemma rec_Vr[simp]: "rec (Vr x) = VrB x"
-using morFromTrm_rec unfolding morFromTrm_def by auto
+lemma rec_Vr[simp]: "rec (Vr x) = VrB x"
+using morFromTrm_rec unfolding morFromTrm_def by auto
 
-lemma rec_Ap[simp]: "rec (Ap e1 e2) = ApB (rec e1) (rec e2)"
-using morFromTrm_rec unfolding morFromTrm_def by auto
+lemma rec_Ap[simp]: "rec (Ap e1 e2) = ApB (rec e1) (rec e2)"
+using morFromTrm_rec unfolding morFromTrm_def by auto
 
-lemma rec_Lm[simp]: "rec (Lm x e) = LmB x (rec e)"
-using morFromTrm_rec unfolding morFromTrm_def by auto
+lemma rec_Lm[simp]: "rec (Lm x e) = LmB x (rec e)"
+using morFromTrm_rec unfolding morFromTrm_def by auto
 
-lemma rec_rrename: "bij σ ⟹ |supp σ| <o |UNIV::var set| ⟹ 
- rec (rrename σ e) = renB σ (rec e)"
-using morFromTrm_rec unfolding morFromTrm_def by auto
+lemma rec_rrename: "bij σ ⟹ |supp σ| <o |UNIV::var set| ⟹
+ rec (rrename σ e) = renB σ (rec e)"
+using morFromTrm_rec unfolding morFromTrm_def by auto
 
-lemma FVarsB_rec: "FVarsB (rec e) ⊆ FFVars e"
-using morFromTrm_rec unfolding morFromTrm_def by auto
+lemma FVarsB_rec: "FVarsB (rec e) ⊆ FFVars e"
+using morFromTrm_rec unfolding morFromTrm_def by auto
 
-lemma rec_unique: 
-assumes "⋀e. H e ∈ B" 
-"⋀x. H (Vr x) = VrB x" 
-"⋀e1 e2. H (Ap e1 e2) = ApB (H e1) (H e2)"
-"⋀x e. H (Lm x e) = LmB x (H e)"
-shows "H = rec"
+lemma rec_unique: 
+assumes "⋀e. H e ∈ B" 
+"⋀x. H (Vr x) = VrB x" 
+"⋀e1 e2. H (Ap e1 e2) = ApB (H e1) (H e2)"
+"⋀x e. H (Lm x e) = LmB x (H e)"
+shows "H = rec"
 apply(rule ext) subgoal for e apply(induct e)
-using assms by auto .
+using assms by auto .
 
 
 end (* context LC_Rec *)
 
-
-
-
+lemmas smalls = emp_bound singl_bound ltermP.Un_bound infinite ltermP.card_of_FFVars_bounds
+declare smalls[refresh_smalls]
+declare Lm_inject[refresh_simps]
+declare Lm_eq_tvsubst[refresh_intros] ltermP.rrename_cong_ids[symmetric, refresh_intros]
+declare id_on_antimono[refresh_elims]
 
 end
 

diff --git a/html/Untyped_Lambda_Calculus/LC_Beta.html b/html/Untyped_Lambda_Calculus/LC_Beta.html
index 3fd21eba..d38a1792 100644
--- a/html/Untyped_Lambda_Calculus/LC_Beta.html
+++ b/html/Untyped_Lambda_Calculus/LC_Beta.html
@@ -27,19 +27,7 @@ 
Theory LC_Beta

   Beta: "step (Ap (Lm x e1) e2) (tvsubst (Vr(x:=e2)) e1)"
 | ApL: "step e1 e1' ⟹ step (Ap e1 e2) (Ap e1' e2)"
 | ApR: "step e2 e2' ⟹ step (Ap e1 e2) (Ap e1 e2')"
-| Xi: "step e e' ⟹ step (Lm x e) (Lm x e')"
-  subgoal for σ R B t  ― ‹equivariance›
-    by (elim disj_forward case_prodE)
-      (auto simp: isPerm_def ltermP.rrename_comps rrename_tvsubst_comp
-         | ((rule exI[of _ "σ _"] exI)+, (rule conjI)?, rule refl)
-         | ((rule exI[of _ "σ _"])+; auto))+
-  subgoal premises prems for R B x1 x2  ― ‹refreshability›
-    using fresh[of x1 x2] prems(2-) unfolding isPerm_def conj_assoc[symmetric] split_beta
-    unfolding ex_push_inwards conj_disj_distribL ex_disj_distrib
-    apply (elim disj_forward exE; simp)
-     apply (metis Lm_eq_tvsubst Lm_inject_swap singletonD)
-    by blast
-    done
+| Xi: "step e e' ⟹ step (Lm x e) (Lm x e')" .
 
 thm step.strong_induct 
 thm step.equiv
@@ -53,7 +41,8 @@ 
Theory LC_Beta

 unfolding stream_all2_iff_snth using red_step by auto
 
 
-end

+end
+

 
 
 
\ No newline at end of file
diff --git a/html/Untyped_Lambda_Calculus/LC_Beta_depth.html b/html/Untyped_Lambda_Calculus/LC_Beta_depth.html
index 815d7031..161d472a 100644
--- a/html/Untyped_Lambda_Calculus/LC_Beta_depth.html
+++ b/html/Untyped_Lambda_Calculus/LC_Beta_depth.html
@@ -31,19 +31,7 @@ 
Theory LC_Beta_depth

   Beta: "stepD 0 (Ap (Lm x e1) e2) (tvsubst (Vr(x:=e2)) e1)"
 | ApL: "stepD d e1 e1' ⟹ stepD (Suc d) (Ap e1 e2) (Ap e1' e2)"
 | ApR: "stepD d e2 e2' ⟹ stepD (Suc d) (Ap e1 e2) (Ap e1 e2')"
-| Xi: "stepD d e e' ⟹ stepD d (Lm x e) (Lm x e')"
-  subgoal for R B σ x1 x2 x3
-    by (elim disj_forward exE case_prodE)
-      (auto simp: isPerm_def ltermP.rrename_comps rrename_tvsubst_comp
-        | ((rule exI[of _ "σ _"] exI)+, (rule conjI)?, rule refl)
-        | ((rule exI[of _ "σ _"])+; auto))+
-  subgoal premises prems for R B x1 x2 x3
-    using fresh[of x2 x3] prems(2-)
-    unfolding ex_push_inwards conj_disj_distribL ex_disj_distrib
-    apply (elim disj_forward exE; simp)
-     apply (metis Lm_eq_tvsubst Lm_refresh singletonD)
-    by blast
-  done
+| Xi: "stepD d e e' ⟹ stepD d (Lm x e) (Lm x e')" .
 
 thm stepD.strong_induct
 thm stepD.equiv
@@ -57,7 +45,8 @@ 
Theory LC_Beta_depth

 unfolding stream_all2_iff_snth using red_stepD by auto
 
 
-end

+end
+

 
 
 
\ No newline at end of file
diff --git a/html/Untyped_Lambda_Calculus/LC_Parallel_Beta.html b/html/Untyped_Lambda_Calculus/LC_Parallel_Beta.html
index 4fb4a8c0..522ce664 100644
--- a/html/Untyped_Lambda_Calculus/LC_Parallel_Beta.html
+++ b/html/Untyped_Lambda_Calculus/LC_Parallel_Beta.html
@@ -23,19 +23,13 @@ 
Theory LC_Parallel_Beta

 lemma fresh: "∃xx. xx ∉ Tsupp (t1 :: lterm) t2"
   by (metis (no_types, lifting) exists_var finite_iff_le_card_var ltermP.Un_bound ltermP.set_bd_UNIV)
 
-binder_inductive pstep :: "lterm ⇒ lterm ⇒ bool" where
+binder_inductive (no_auto_refresh) pstep :: "lterm ⇒ lterm ⇒ bool" where
   Refl: "pstep e e"
 | Ap: "pstep e1 e1' ⟹ pstep e2 e2' ⟹ pstep (Ap e1 e2) (Ap e1' e2')"
 | Xi: "pstep e e' ⟹ pstep (Lm x e) (Lm x e')"
 | PBeta: "pstep e1 e1' ⟹ pstep e2 e2' ⟹ pstep (Ap (Lm x e1) e2) (tvsubst (Vr(x:=e2')) e1')"
-  subgoal for σ R B x1 x2
-    by (elim disj_forward exE)
-      (auto simp: isPerm_def
-         ltermP.rrename_comps rrename_tvsubst_comp
-         | ((rule exI[of _ "σ _"] exI)+, (rule conjI)?, rule refl)
-         | ((rule exI[of _ "σ _"])+; auto))+
-  subgoal premises prems for R B x1 x2
-    using fresh[of x1 x2] prems(2-)
+  subgoal premises prems for R B x1 x2
+    using fresh[of x1 x2] prems(2-)
     unfolding ex_push_inwards conj_disj_distribL ex_disj_distrib
     apply (elim disj_forward exE)
      apply (((rule exI, rule conjI[rotated], assumption) |
@@ -73,7 +67,8 @@ 
Theory LC_Parallel_Beta

 thm pstep.strong_induct
 thm pstep.equiv
 
-end

+end
+

 
 
 
\ No newline at end of file
diff --git a/html/Untyped_Lambda_Calculus/session_graph.pdf b/html/Untyped_Lambda_Calculus/session_graph.pdf
index 2815dff8..d2c56350 100644
Binary files a/html/Untyped_Lambda_Calculus/session_graph.pdf and b/html/Untyped_Lambda_Calculus/session_graph.pdf differ
diff --git a/thys/Infinitary_FOL/InfFOL.thy b/thys/Infinitary_FOL/InfFOL.thy
index 2a7a122c..0e689eff 100644
--- a/thys/Infinitary_FOL/InfFOL.thy
+++ b/thys/Infinitary_FOL/InfFOL.thy
@@ -1,7 +1,7 @@
 theory InfFOL imports InfFmla
 begin
 
-binder_inductive deduct :: "fmla set\<^sub>k \ fmla \ bool" (infix "\" 100) where
+binder_inductive (no_auto_equiv, no_auto_refresh) deduct :: "fmla set\<^sub>k \ fmla \ bool" (infix "\" 100) where
   Hyp: "f \\<^sub>k \ \ \ \ f"
 | ConjI: "(\f. f \\<^sub>k\<^sub>1 F \ \ \ f) \ \ \ Conj F"
 | ConjE: "\ \ \ Conj F ; f \\<^sub>k\<^sub>1 F \ \ \ \ f"
diff --git a/thys/Infinitary_Lambda_Calculus/ILC_Beta.thy b/thys/Infinitary_Lambda_Calculus/ILC_Beta.thy
index df38d72c..015f0050 100644
--- a/thys/Infinitary_Lambda_Calculus/ILC_Beta.thy
+++ b/thys/Infinitary_Lambda_Calculus/ILC_Beta.thy
@@ -18,7 +18,7 @@ lemma small_Tsupp: "small (Tsupp t1 t2)"
 lemma Tvars_dsset: "(Tsupp t1 t2 - dsset xs) \ dsset xs = {}" "|Tsupp t1 t2 - dsset xs|  ilterm \ bool" where
+binder_inductive (no_auto_equiv, no_auto_refresh) istep :: "ilterm \ ilterm \ bool" where
   Beta: "istep (iAp (iLm xs e1) es2) (itvsubst (imkSubst xs es2) e1)"
 | iApL: "istep e1 e1' \ istep (iAp e1 es2) (iAp e1' es2)"
 | iApR: "istep (snth es2 i) e2' \ istep (iAp e1 es2) (iAp e1 (supd es2 i e2'))"
diff --git a/thys/Infinitary_Lambda_Calculus/ILC_affine.thy b/thys/Infinitary_Lambda_Calculus/ILC_affine.thy
index a4e2808d..6a9b9cdf 100644
--- a/thys/Infinitary_Lambda_Calculus/ILC_affine.thy
+++ b/thys/Infinitary_Lambda_Calculus/ILC_affine.thy
@@ -10,7 +10,7 @@ begin
 lemma Tvars_dsset: "(FFVars t - dsset xs) \ dsset xs = {}" "|FFVars t - dsset xs|  bool" where
+binder_inductive (no_auto_equiv, no_auto_refresh) affine  :: "ilterm \ bool" where
  iVr[simp,intro!]: "affine (iVr x)"
 |iLm: "affine e \ affine (iLm xs e)"
 |iAp:
diff --git a/thys/Infinitary_Lambda_Calculus/PrettyPrinting.thy b/thys/Infinitary_Lambda_Calculus/PrettyPrinting.thy
deleted file mode 100644
index caf7d7ba..00000000
--- a/thys/Infinitary_Lambda_Calculus/PrettyPrinting.thy
+++ /dev/null
@@ -1,414 +0,0 @@
-theory PrettyPrinting
-imports "Untyped_Lambda_Calculus.LC" (*BSmall*) "Prelim.Curry_LFP" (* ILC2 *)
-"Binders.Generic_Strong_Rule_Induction"
-begin
-
-(* *)
-(* raw terms: *)
-datatype rtrm = VAR var | APP rtrm rtrm | LAM var rtrm
-
-fun Vrs where 
-"Vrs (VAR x) = {x}"
-|
-"Vrs (APP T S) = Vrs T \ Vrs S"
-|
-"Vrs (LAM x T) = {x} \ Vrs T"
-
-lemma finite_Vrs[intro]: "finite (Vrs T)"
-by (induct T, auto)
-
-fun rrrename where 
-"rrrename f (VAR x) = VAR (f x)"
-|
-"rrrename f (APP T S) = APP (rrrename f T) (rrrename f S)"
-|
-"rrrename f (LAM x T) = LAM (f x) (rrrename f T)"
-
-lemma rrrename_id[simp]: "rrrename id = id"
-apply(rule ext) subgoal for T by (induct T, auto) .
-
-lemma rrrename_o[simp]: "rrrename (g o f) = rrrename g o rrrename f"
-apply(rule ext) subgoal for T by (induct T, auto) .
-
-lemma rrrename_Vrs[simp]: "Vrs (rrrename f T) = f ` (Vrs T)"
-by (induct T, auto)
-
-lemma rrrename_cong: 
-"\x\Vrs T. f x = x \ rrrename f T = T"
-by (induct T, auto)
-
-
-(* ASCII-only variables: *)
-consts AVr :: "var set"
-
-axiomatization where infinite_AVr: "infinite AVr"
-
-term usub
-
-inductive ppr :: "trm \ rtrm \ bool" where
-  Vr_VAR: "x \ AVr \ ppr (Vr x) (VAR x)"
-| Ap_APP: "ppr t T \ ppr s S \ ppr (Ap t s) (APP T S)"
-| Lm_LAM: "y \ AVr \ y \ {x} \ FFVars t \  
-    ppr (usub t y x) T \ ppr (Lm x t) (LAM y T)"
-
-
-(* INSTANTIATING THE ABSTRACT SETTING: *)
-
-(* PREPARING THE INSTANTIATION: *)
-
-type_synonym B = "(var \ var) set"
-
-fun Bperm :: "(var \ var) \ B \ B" where 
-"Bperm f = image (map_prod f f)"
-
-fun Bsupp :: "B \ var set" where 
-"Bsupp XY = image fst XY \ \\ image snd XY \"
-
-fun bnd :: "B \ bool" where 
-"bnd XY \ finite XY \ image snd XY \ AVr"
-
-
-fun bsmall :: "var set \ bool"
-where 
-"bsmall XY = finite XY" 
-
-(*
-lemma ppr_touchedSuperT: 
-"ppr e1 e2 \ touchedSuperT e1 = touchedSuperT e2 \ finite (touchedSuperT e1) \ finite (touchedSuperT e2) "
-proof(induct rule: ppr.induct)
-  case (iVr xs x x')
-  then show ?case by auto 
-next
-  case (iLm xs e e')
-  then show ?case by auto
-next
-  case (iAp e1 e1' es2 es2')
-  obtain e2 e2' where e2: "e2 \ sset es2" and e2': "e2' \ sset es2'" 
-  using shd_sset by blast+
-  hence 0: "touchedSuperT ` sset es2 = {touchedSuperT e2}" "touchedSuperT ` sset es2' = {touchedSuperT e2}"
-  using iAp(3) by auto
-  have "\ (touchedSuperT ` sset es2) = \ (touchedSuperT ` sset es2') \
-       finite (\ (touchedSuperT ` sset es2)) \ finite (\ (touchedSuperT ` sset es2'))" 
-  unfolding 0 using iAp(3) e2 e2' by auto    
-  thus ?case using iAp by simp
-qed
-
-lemmas ppr_touchedSuperT_eq = ppr_touchedSuperT[THEN conjunct1]
-lemmas ppr_finite_touchedSuperT = ppr_touchedSuperT[THEN conjunct2]
-*)
-
-(* INSTANTIATING THE CComponents LOCALE: *)
-
-type_synonym T = "trm \ rtrm"
-
-definition Tperm :: "(var \ var) \ T \ T" where 
-"Tperm f \ map_prod (rrename f) (rrrename f)"
-
-fun Tsupp :: "T \ var set" where 
-"Tsupp (e1,e2) = FFVars e1 \ Vrs e2"
-
-
-
-interpretation CComponents where
-Tperm = Tperm and Tsupp = Tsupp 
-and Bperm = Bperm and Bsupp = Bsupp and bnd = bnd and bsmall = bsmall
-apply standard unfolding isPerm_def Tperm_def  apply auto
-  subgoal apply(rule ext) by (auto simp add: term.rrename_comps image_def)
-  subgoal by (simp add: Un_bound finite_Vrs infinite_var small_def term.set_bd_UNIV)
-  subgoal by (simp add: rrrename_cong)
-  subgoal apply(rule ext) using image_iff by fastforce
-  subgoal using finite_iff_le_card_var small_def by blast 
-  subgoal unfolding image_def by force 
-  (* subgoal unfolding image_def sledgehammer by force . *) sorry
-  subgoal unfolding image_def by (metis (mono_tags, lifting) Un_iff fst_conv mem_Collect_eq snd_conv) 
-  subgoal  
-    by (smt (verit, del_insts) Un_iff fst_conv fst_map_prod imageI snd_conv snd_map_prod surj_pair) .
-
-
-
-lemma presBnd_imp: "presBnd \ \ \ ` AVr \ AVr"
-unfolding presBnd_def apply auto subgoal for x apply(erule allE[of _ "{(undefined,x)}"])
-apply auto
- by auto .
-
-(*
-lemma presBnd_presSuper: "presBnd = presSuper"
-unfolding presBnd_def presSuper_def fun_eq_iff apply safe
-  subgoal for \ xs apply(erule allE[of _ "Some xs"]) by auto 
-  subgoal for \ xs apply(erule allE[of _ "Some xs"]) by auto 
-  subgoal for \ xxs apply(cases xxs) by auto 
-  subgoal for \ xxs apply(cases xxs) by auto .
-*)
-
-(*
-inductive ppr :: "trm \ rtrm \ bool" where
-  Vr_VAR: "x \ AVr \ ppr (Vr x) (VAR x)"
-| Ap_APP: "ppr t T \ ppr s S  \ ppr (Ap t s) (APP T S)"
-| Lm_LAM: "y \ {x} \ FFVars t \ Vrs T \  
-    ppr (usub t y x) t' \ ppr (Lm x t) (LAM y T)"
-*)
-
-definition G :: "B \ (T \ bool) \ T \ bool"
-where
-"G \ \B R tt.  
-         (\x. B = {} \ fst tt = Vr x \ snd tt = VAR x \ 
-              x \ AVr) 
-         \
-         (\t T s S. B = {} \ fst tt = Ap t s \ snd tt = APP T S \ 
-                    R (t,T) \ R (s,S))
-         \ 
-         (\y x t T. B = {(x,y)} \ fst tt = Lm x t \ snd tt = LAM y T \ 
-                    y \ AVr \ y \ {x} \ FFVars t \ R (usub t y x,T))"
- 
-
-(* VERIFYING THE HYPOTHESES FOR BARENDREGT-ENHANCED INDUCTION: *)
-
-lemma G_mmono: "R \ R' \ G xxs R t \ G xxs R' t"
-unfolding G_def by fastforce 
-
-(* NB: Everything is passed \-renamed as witnesses to exI *)
-lemma G_eequiv: 
-"isPerm \ \ presBnd \ \ G B R tt \ 
- G  (Bperm \ B) (\tt'. R (Tperm (inv \) tt')) (Tperm \ tt)"
-unfolding G_def apply(drule presBnd_imp) apply(elim disjE)
-  subgoal apply(rule disjI3_1)
-  subgoal apply(elim exE) subgoal for x
-  apply(rule exI[of _ "\ x"])  
-  apply(cases tt) unfolding isPerm_def small_def Tperm_def by auto . . 
-  (* *)
-  subgoal apply(rule disjI3_2)
-  subgoal apply(elim exE) subgoal for t T s S
-  apply(rule exI[of _ "rrename \ t"]) 
-  apply(rule exI[of _ "rrrename \ T"])
-  apply(rule exI[of _ "rrename \ s"]) 
-  apply(rule exI[of _ "rrrename \ S"])  
-  apply(cases tt) unfolding isPerm_def small_def Tperm_def 
-  by simp (metis comp_apply id_apply inv_o_simp1 rrrename_id rrrename_o 
-    term.rrename_bijs term.rrename_inv_simps) . . 
-  (* *)
-  subgoal apply(rule disjI3_3)
-  subgoal apply(elim exE) subgoal for y x t T
-  apply(rule exI[of _ "\ y"]) apply(rule exI[of _ "\ x"]) 
-  apply(rule exI[of _ "rrename \ t"]) apply(rule exI[of _ "rrrename \ T"]) 
-  apply(cases tt) unfolding isPerm_def small_def Tperm_def apply simp 
-    by (metis comp_apply id_apply imageI inv_o_simp1 not_imageI rrrename_id rrrename_o subsetD term.rrename_bijs term.rrename_inv_simps)
-   . . .
-
-
-
-(* *)
-
-lemma G_bnd: "G B R tt \ bnd B"
-unfolding G_def by auto
-
-lemma eextend_to_presBnd: 
-assumes "bnd B" "small A" "bsmall A" "A' \ A" "Bsupp B \ A' = {}"
-shows "\\. isPerm \ \ presBnd \ \ \ ` Bsupp B \ A = {} \ id_on A' \" 
-sorry
-(* proof(cases xxs)
-  case None
-  thus ?thesis apply(intro exI[of _ id]) unfolding isPerm_def by auto
-next
-  case (Some xs)
-  hence 0: "super xs" "|A|  A"
-  "dsset xs \ A' = {}"
-  using assms by (auto split: option.splits simp: small_def bsmall_def) 
-  show ?thesis using extend_super[OF 0] apply safe
-  subgoal for \ apply(rule exI[of _ \]) 
-  using Some by (auto split: option.splits simp: presBnd_presSuper isPerm_def) .
-qed 
-*)
-
-
-interpretation Ppr : IInduct1 
-where Tperm = Tperm and Tsupp = Tsupp and Bperm = Bperm and Bsupp = Bsupp 
-and bnd = bnd and bsmall = bsmall and GG = G
-apply standard
-using G_mmono G_eequiv G_bnd eextend_to_presBnd by auto
-
-
-(* *)
-
-lemma ppr_I: "ppr t1 t2 = Ppr.II (t1,t2)" 
-unfolding ppr_def Ppr.II_def lfp_curry2 apply(rule arg_cong2[of _ _ _ _ lfp], simp_all)
-unfolding fun_eq_iff G_def apply clarify
-subgoal for R tt1 tt2 apply(rule iffI)
-  subgoal apply(elim disjE exE conjE)
-    \<^cancel>\Vr_VAR: \
-    subgoal for x apply(rule exI[of _ "{}"]) apply(rule disjI3_1) by auto
-    \<^cancel>\Ap_APP: \
-    subgoal for t T s S apply(rule exI[of _ "{}"]) apply(rule disjI3_2) by auto 
-    \<^cancel>\Lm_LAM: \
-    subgoal for y x t T apply(rule exI[of _ "{(x,y)}"]) apply(rule disjI3_3) by auto . 
-    (* *)
-  subgoal apply(elim disjE exE conjE)
-    \<^cancel>\iVr: \
-    subgoal apply(rule disjI3_1) by auto
-    \<^cancel>\iLm: \
-    subgoal apply(rule disjI3_2) by auto
-    \<^cancel>\iAp: \
-    subgoal apply(rule disjI3_3) by auto . . .
-  
-
-lemma III_bsmall: "Ppr.II t \ bsmall (Tsupp t)"
-apply(cases t)
-  subgoal for e1 e2  
-    apply auto by (simp add: finite_iff_le_card_var term.card_of_FFVars_bounds) .
-
-(*
-lemma Tvars_dsset: "dsset xs \ (Tsupp t - dsset xs) = {}" 
-  "|Tsupp t - dsset xs|  finite (touchedSuper (Tsupp t - dsset ys))"
-subgoal using Diff_disjoint .
-subgoal using small_def card_of_minus_bound ssmall_Tsupp by blast
-subgoal apply(subgoal_tac "bsmall (Tsupp t)")
-  subgoal unfolding bsmall_def 
-    by (meson Diff_subset rev_finite_subset touchedSuper_mono) 
-  subgoal by (metis III_bsmall) . .
-*)
-
-lemma G_rrefresh: 
-"(\tt. R tt \ Ppr.II tt) \ 
- (\\ t. isPerm \ \ presBnd \ \ R tt \ R (Tperm \ tt)) \ 
- G B R tt \ 
- \B'. Bsupp B' \ Tsupp tt = {} \ G B' R tt"
-apply(cases tt) subgoal for t T apply apply simp
-apply(subgoal_tac "Ppr.II tt") defer
-
-
-term term (*
-apply (metis Ppr.GG_mmono2 Ppr.II.simps predicate1I)
-subgoal premises p using p apply-
-apply(frule G_bnd)
-unfolding G_def Tperm_def apply safe
-  subgoal for xs x x' 
-  apply(rule exI[of _ None])  
-  apply(intro conjI)
-    subgoal by simp 
-    subgoal apply(rule disjI3_1) 
-    apply(rule exI[of _ xs]) 
-    apply(rule exI[of _ x])
-    apply(rule exI[of _ x']) 
-    apply(cases t) apply simp . .
-  (* *)
-  subgoal for xs e e' 
-  apply(frule refresh_super[OF Tvars_dsset(1,2) Tvars_dsset(3)[OF p(4)]])
-  apply safe
-  subgoal for f
-  apply(rule exI[of _ "Some (dsmap f xs)"])  
-  apply(intro conjI) 
-    subgoal unfolding id_on_def presSuper_def by (cases t, auto) 
-    subgoal apply(rule disjI3_2)
-    apply(rule exI[of _ "dsmap f xs"]) 
-    apply(rule exI[of _ "irrename f e"]) 
-    apply(rule exI[of _ "irrename f e'"]) 
-    apply(cases t) unfolding presSuper_def apply simp apply(intro conjI)
-      subgoal apply(subst iLm_irrename[of "f"]) unfolding id_on_def by auto
-      subgoal apply(subst irrename_eq_itvsubst_iVr)
-        subgoal unfolding isPerm_def by auto
-        subgoal unfolding isPerm_def by auto
-        subgoal by (smt (verit, best) Diff_iff Un_iff iLm_irrename id_on_def 
-           irrename_eq_itvsubst_iVr) . 
-        subgoal unfolding id_on_def isPerm_def presBnd_def by (auto split: option.splits) . . .
-  (* *)
-  subgoal for e1 e1' es2 es2'
-  apply(rule exI[of _ None])  
-  apply(intro conjI)
-    subgoal by simp 
-    subgoal apply(rule disjI3_3) 
-    apply(rule exI[of _ "e1"]) 
-    apply(rule exI[of _ "e1'"])
-    apply(rule exI[of _ "es2"]) 
-    apply(rule exI[of _ "es2'"]) 
-    apply(cases t) by simp . . .
- 
-
-(* FINALLY, INTERPRETING THE IInduct LOCALE: *)
-
-interpretation Ppr : IInduct
-where Tperm = Tperm and Tsupp = Tsupp and 
-Bperm = Bperm and Bsupp = Bsupp and bnd = bnd and bsmall = bsmall 
-and GG = G
-apply standard using III_bsmall G_rrefresh by auto
-
-(* *)
-
-
-(* FROM ABSTRACT BACK TO CONCRETE: *)
-thm ppr.induct[no_vars] 
-
-corollary strong_induct_ppr[consumes 2, case_names iVr iLm iAp]: 
-assumes par: "\p. small (Psupp p) \ bsmall (Psupp p)"
-and st: "ppr t1 t2"  
-and iVr: "\xs x x' p. 
-  super xs \ {x,x'} \ dsset xs \
-  R p (iVr x) (iVr x')"
-and iLm: "\e e' xs p. 
-  dsset xs \ Psupp p = {} \ 
-  super xs \ ppr e e' \ (\p'. R p' e e') \ 
-  R p (iLm xs e) (iLm xs e')" 
-and iAp: "\e1 e1' es2 es2' p. 
-  ppr e1 e1' \ (\p'. R p' e1 e1') \ 
-  (\e e'. {e,e'} \ sset es2 \ sset es2' \ ppr e e' \ (\p'. R p' e e')) \ 
-  R p (iAp e1 es2) (iAp e1' es2')"
-shows "R p t1 t2"
-unfolding ppr_I
-apply(subgoal_tac "case (t1,t2) of (t1, t2) \ R p t1 t2")
-  subgoal by simp
-  subgoal using par st 
-  unfolding bsmall_def[symmetric] apply(elim Ppr.strong_iinduct[where R = "\p (t1,t2). R p t1 t2"])
-    subgoal unfolding ppr_I by simp
-    subgoal for p B t apply(subst (asm) G_def) 
-    unfolding ppr_I[symmetric] apply(elim disjE exE)
-      subgoal using iVr by auto 
-      subgoal using iLm by auto  
-      subgoal using iAp by auto . . .
-
-corollary strong_induct_ppr''[consumes 1, case_names bsmall Bound iVr iLm iAp]:
-  assumes  "ppr t1 t2"
-and bsmall: "\(p::'a). bsmall (PFVars p)"
-assumes bound: "\(p::'a). |PFVars p| xs x x' p.
-  super xs \ {x,x'} \ dsset xs \
-  R (iVr x) (iVr x') p"
-and iLm: "\e e' xs p.
-  dsset xs \ PFVars p = {} \
-  super xs \ ppr e e' \ (\p'. R e e' p') \
-  R (iLm xs e) (iLm xs e') p"
-and iAp: "\e1 e1' es2 es2' p.
-  ppr e1 e1' \ (\p'. R e1 e1' p') \
-  (\e e'. {e,e'} \ sset es2 \ sset es2' \ ppr e e') \
-  (\e e'. {e,e'} \ sset es2 \ sset es2' \ \p'. R e e' p') \
-  R (iAp e1 es2) (iAp e1' es2') p"
-shows "\(p::'a). R t1 t2 p"
-using assms strong_induct_ppr[of PFVars t1 t2 "\p t1 t2. R t1 t2 p"] unfolding small_def by auto
-
-(* ... and with fixed parameters: *)
-corollary strong_induct_ppr'[consumes 2, case_names iVr iLm iAp]: 
-assumes par: "small A \ bsmall A"
-and st: "ppr t1 t2"  
-and iVr: "\xs x x'. 
-  super xs \ {x,x'} \ dsset xs \
-  R (iVr x) (iVr x')"
-and iLm: "\e e' xs. 
-  dsset xs \ A = {} \ 
-  super xs \ ppr e e' \ R e e' \ 
-  R (iLm xs e) (iLm xs e')" 
-and iAp: "\e1 e1' es2 es2'. 
-  ppr e1 e1' \ R e1 e1' \ 
-  (\e e'. {e,e'} \ sset es2 \ sset es2' \ ppr e e' \ R e e') \ 
-  R (iAp e1 es2) (iAp e1' es2')"
-shows "R t1 t2"
-apply(rule strong_induct_ppr[of "\_::unit. A"]) using assms by auto
-
-(* Also inferring equivariance from the general infrastructure: *)
-corollary irrename_ppr:
-assumes f: "bij f" "|supp f|  \ |supp \|  bsmall (supp \) \ presSuper \ \ 
   super xs \ x \ dsset xs \ 
   renB \ (iVrB x) = iVrB (\ x)"
-unfolding renB_def iVrB_def apply(subst rrename_simps)
+unfolding renB_def iVrB_def apply(subst ltermP.permute)
   subgoal by (auto simp add: bij_restr)
   subgoal by (auto simp add: card_supp_restr)
   subgoal unfolding restr_def apply(cases "theSN x", cases "theSN (\ x)") 
@@ -126,7 +126,7 @@ unfolding renB_def iVrB_def apply(subst rrename_simps)
 lemma renB_iApB[simp]: "bij \ \ |supp \|  bsmall (supp \) \ presSuper \ \ 
    b1 \ B \ sset bs2 \ B \
    renB \ (iApB b1 bs2) = iApB (renB \ b1) (smap (renB \) bs2)"
-unfolding renB_def iApB_def apply(subst rrename_simps)
+unfolding renB_def iApB_def apply(subst ltermP.permute)
   subgoal by (auto simp add: bij_restr)
   subgoal by (auto simp add: card_supp_restr)
   subgoal by auto .
@@ -134,7 +134,7 @@ unfolding renB_def iApB_def apply(subst rrename_simps)
 lemma renB_iLmB[simp]: "bij \ \ |supp \|  bsmall (supp \) \ presSuper \ \ 
    b \ B \ super xs \ 
    renB \ (iLmB xs b) = iLmB (dsmap \ xs) (renB \ b)"
-unfolding renB_def iLmB_def apply(subst rrename_simps)
+unfolding renB_def iLmB_def apply(subst ltermP.permute)
   subgoal by (auto simp add: bij_restr)
   subgoal by (auto simp add: card_supp_restr)
   subgoal using restr_def superOf_subOf by auto .
diff --git a/thys/MRBNF_FP.thy b/thys/MRBNF_FP.thy
index b9b074c4..ba145e0a 100644
--- a/thys/MRBNF_FP.thy
+++ b/thys/MRBNF_FP.thy
@@ -347,13 +347,19 @@ lemma extend_fresh:
   unfolding Int_Un_distrib fun_eq_iff o_apply id_apply
   by blast
 
+named_theorems refresh_extends
+named_theorems refresh_smalls
+named_theorems refresh_simps
+named_theorems refresh_intros
+named_theorems refresh_elims
+
 ML \
 local
   open BNF_Util
   open BNF_FP_Util
 in
 
-fun refreshability_tac verbose supps renames instss G_thm eqvt_thm extend_thms small_thms simp_thms intro_thms elim_thms ctxt =
+fun refreshability_tac_common verbose supps instss G_thm eqvt_thm extend_thms small_thms simp_thms intro_thms elim_thms ctxt =
   let
     val n = length supps;
     fun case_tac NONE _ prems ctxt = HEADGOAL (Method.insert_tac ctxt prems THEN' 
@@ -375,15 +381,17 @@ val _ = prems |> map (Thm.pretty_thm ctxt #> verbose ? @{print tracing});
             |> Library.foldl1 (HOLogic.mk_binop \<^const_name>\sup\);
           val fresh = infer_instantiate' ctxt [SOME (Thm.cterm_of ctxt B), SOME (Thm.cterm_of ctxt A)]
             @{thm extend_fresh};
+          val _ = (verbose ? @{print tracing}) fresh
 
           fun case_inner_tac fs fprems ctxt =
-            let
+            let 
+              val _ = (verbose ? @{print tracing}) fs
               val f = hd fs |> snd |> Thm.term_of;
               val ex_f = infer_instantiate' ctxt [NONE, SOME (Thm.cterm_of ctxt f)] exI;
               val ex_B' = infer_instantiate' ctxt [NONE, SOME (Thm.cterm_of ctxt (mk_image f $ B))] exI;
               val args = params |> map (snd #> Thm.term_of);
               val xs = @{map 2} (fn i => fn a => Thm.cterm_of ctxt
-                (case i of SOME i => nth renames i $ f $ a | NONE => a)) insts args;
+                (case i of SOME t => t $ f $ a | NONE => a)) insts args;
 val _ = fprems |> map (Thm.pretty_thm ctxt #> verbose ? @{print tracing});
               val eqvt_thm = eqvt_thm OF take 2 fprems;
               val extra_assms = assms RL (eqvt_thm :: extend_thms);
@@ -403,24 +411,40 @@ val _ = extra_assms |> map (Thm.pretty_thm ctxt #> verbose ? @{print tracing});
                   addSEs elim_thms) 0 10) THEN_ALL_NEW (SELECT_GOAL (print_tac ctxt "auto failed")))
             end;
           val small_ctxt = ctxt addsimps small_thms;
-        in
-          HEADGOAL (rtac ctxt (fresh RS exE) THEN'
-          SELECT_GOAL (auto_tac (small_ctxt addsimps [hd defs])) THEN'
-          REPEAT_DETERM_N 2 o (asm_simp_tac small_ctxt) THEN'
-          SELECT_GOAL (unfold_tac ctxt @{thms Int_Un_distrib Un_empty}) THEN'
-          REPEAT_DETERM o etac ctxt conjE THEN'
+        in EVERY1 [
+          rtac ctxt (fresh RS exE),
+          if verbose then K (print_tac ctxt "after_fresh") else K all_tac,
+          SELECT_GOAL (auto_tac (small_ctxt addsimps [hd defs])),
+          if verbose then K (print_tac ctxt "after_auto") else K all_tac,
+          REPEAT_DETERM_N 2 o (asm_simp_tac small_ctxt),
+          SELECT_GOAL (unfold_tac ctxt @{thms Int_Un_distrib Un_empty}),
+          REPEAT_DETERM o etac ctxt conjE,
+          if verbose then K (print_tac ctxt "pre_case_inner_tac") else K all_tac,
           Subgoal.SUBPROOF (fn focus =>
-            case_inner_tac (#params focus) (#prems focus) (#context focus)) ctxt)
-        end;
+            case_inner_tac (#params focus) (#prems focus) (#context focus)) ctxt
+        ] end;
   in
-    unfold_tac ctxt @{thms conj_disj_distribL ex_disj_distrib} THEN
-    HEADGOAL (
-      rtac ctxt (G_thm RSN (2, cut_rl)) THEN'
-      REPEAT_ALL_NEW (eresolve_tac ctxt @{thms exE conjE disj_forward}) THEN'
+    unfold_tac ctxt @{thms conj_disj_distribL ex_disj_distrib} THEN EVERY1 [
+      rtac ctxt (G_thm RSN (2, cut_rl)),
+      REPEAT_ALL_NEW (eresolve_tac ctxt @{thms exE conjE disj_forward}),
+      if verbose then K (print_tac ctxt "pre_case_tac") else K all_tac,
       EVERY' (map (fn insts => Subgoal.SUBPROOF (fn focus =>
-        case_tac insts (#params focus) (#prems focus) (#context focus)) ctxt) instss))
+        case_tac insts (#params focus) (#prems focus) (#context focus)) ctxt) instss)
+    ]
   end;
 
+fun refreshability_tac_internal verbose supps instss G_thm eqvt_thm smalls simps ctxt =
+  refreshability_tac_common verbose supps instss G_thm eqvt_thm
+    (Named_Theorems.get ctxt "MRBNF_FP.refresh_extends")
+    (smalls @ Named_Theorems.get ctxt "MRBNF_FP.refresh_smalls")
+    (simps @ Named_Theorems.get ctxt "MRBNF_FP.refresh_simps")
+    (Named_Theorems.get ctxt "MRBNF_FP.refresh_intros")
+    (Named_Theorems.get ctxt "MRBNF_FP.refresh_elims") ctxt;
+
+fun refreshability_tac verbose supps renames instss =
+  let val instss' = map (Option.map (map (Option.map (nth renames)))) instss
+  in refreshability_tac_common verbose supps instss' end
+
 end;
 \
 
diff --git a/thys/MRBNF_Recursor.thy b/thys/MRBNF_Recursor.thy
index a9b6ddf5..85586845 100644
--- a/thys/MRBNF_Recursor.thy
+++ b/thys/MRBNF_Recursor.thy
@@ -13,6 +13,18 @@ ML_file \../Tools/mrbnf_sugar.ML\
 
 declare [[inductive_internals]]
 
+named_theorems equiv
+named_theorems equiv_commute
+named_theorems equiv_simps
+
+declare Un_iff[equiv_simps] de_Morgan_disj[equiv_simps]
+  inj_image_mem_iff[OF bij_is_inj, equiv_simps]
+  singleton_iff[equiv_simps] image_empty[equiv_simps]
+  Int_Un_distrib[equiv_simps] Un_empty[equiv_simps]
+  image_is_empty[equiv_simps] image_Int[OF bij_is_inj, symmetric, equiv_simps]
+  inj_eq[OF bij_is_inj, equiv_simps] inj_eq[OF bij_is_inj, equiv_simps]
+  image_insert[equiv_simps] insert_iff[equiv_simps] notin_empty_eq_True[equiv_simps]
+
 context begin
 ML_file \../Tools/binder_induction.ML\
 end
@@ -23,4 +35,4 @@ typedecl ('a, 'b) var_selector (infix "::" 999)
 
 ML_file "../Tools/parser.ML"
 
-end
\ No newline at end of file
+end
diff --git a/thys/POPLmark/POPLmark_1A.thy b/thys/POPLmark/POPLmark_1A.thy
index f8bfd8db..548de7a1 100644
--- a/thys/POPLmark/POPLmark_1A.thy
+++ b/thys/POPLmark/POPLmark_1A.thy
@@ -4,10 +4,25 @@ begin
 
 (********************* Actual formalization ************************)
 
-lemma ty_refl: "\wf \ ; T closed_in \ \ \ \ \ T <: T"
-proof (binder_induction T arbitrary: \ avoiding: "dom \" rule: Type.strong_induct)
-  case (TyVar x \)
-  then show ?case by blast
+declare ty.intros[intro]
+
+lemma well_scoped:
+  assumes "\ \ S <: T"
+  shows "FFVars_sftypeP S \ dom \" "FFVars_sftypeP T \ dom \"
+using assms proof (induction \ S T rule: ty.induct)
+  case (SA_Trans_TVar x U \ T) {
+  case 1 then show ?case using SA_Trans_TVar
+    by (metis fst_conv imageI singletonD subsetI sftypeP.set(1))
+next
+  case 2 then show ?case using SA_Trans_TVar by simp
+} qed auto
+
+declare SA_Refl_TVar[intro!]
+
+lemma ty_refl: "\wf \ ; FFVars_sftypeP T \ dom \ \ \ \ \ T <: T"
+proof (binder_induction T arbitrary: \ avoiding: "dom \" rule: sftypeP.strong_induct)
+  case (TVr x \)
+  then show ?case by (simp add: SA_Refl_TVar)  
 qed (auto simp: Diff_single_insert SA_All wf_Cons)
 
 lemma ty_permute: "\ \ \ S <: T ; wf \ ; set \ = set \ \ \ \ \ S <: T"
@@ -29,7 +44,7 @@ proof (induction \ rule: wf.induct)
     using wf_Cons by auto
 qed auto
 
-lemma weaken_closed: "\ S closed_in \ ; \ \ \ \ \ S closed_in \,,\"
+lemma weaken_closed: "\ FFVars_sftypeP S \ dom \ ; \ \ \ \ \ FFVars_sftypeP S \ dom (\,,\)"
   by auto
 
 lemma wf_concat_disjoint: "wf (\,, \) \ \ \ \"
@@ -39,7 +54,7 @@ proof (induction \)
     by (smt (verit, del_insts) Un_iff append_Cons disjoint_iff fst_conv image_iff inf.idem insertE list.inject list.simps(15) set_append set_empty2 wf.cases)
 qed simp
 
-lemma wf_insert: "\ wf (\,,\); x \ dom \ ; x \ dom \ ; T closed_in \ \ \ wf (\,,x<:T,,\)"
+lemma wf_insert: "\ wf (\,,\); x \ dom \ ; x \ dom \ ; FFVars_sftypeP T \ dom \ \ \ wf (\,,x<:T,,\)"
   by (induction \) auto
 
 lemma ty_weakening:
@@ -50,7 +65,8 @@ using assms proof (binder_induction \ S T avoiding: "dom \" \ x)
-  then show ?case using ty.SA_Refl_TVar weaken_closed wf_concat_disjoint by presburger
+  then show ?case using ty.SA_Refl_TVar weaken_closed wf_concat_disjoint  
+    by (meson ty_refl well_scoped(1))   
 next
   case (SA_All \ T\<^sub>1 S\<^sub>1 x S\<^sub>2 T\<^sub>2)
   have 1: "wf (\,, x <: T\<^sub>1,, \)"
@@ -60,7 +76,7 @@ next
   show ?case using ty_permute[OF _ 2] 1 SA_All by auto
 qed auto
 
-corollary ty_weakening_extend: "\ \ \ S <: T ; X \ dom \ ; Q closed_in \ \ \ \,,X<:Q \ S <: T"
+corollary ty_weakening_extend: "\ \ \ S <: T ; X \ dom \ ; FFVars_sftypeP Q \ dom \ \ \ \,,X<:Q \ S <: T"
   using ty_weakening[of _ _ _ "[(X, Q)]"] by (metis append_Cons append_Nil wf_Cons wf_context)
 
 lemma wf_concatD: "wf (\,, \) \ wf \"
@@ -73,7 +89,7 @@ proof (induction \)
     by (metis Pair_inject append_Nil fst_conv image_eqI set_ConsD wf_ConsE)
 qed auto
 
-lemma narrow_wf: "\ wf ((\ ,, X <: Q),, \) ; R closed_in \ \ \ wf ((\,, X <: R),, \)"
+lemma narrow_wf: "\ wf ((\ ,, X <: Q),, \) ; FFVars_sftypeP R \ dom \ \ \ wf ((\,, X <: R),, \)"
 proof (induction \)
   case (Cons a \)
   then have "wf (\,, X <: R,, \)" by auto
@@ -83,24 +99,22 @@ proof (induction \)
   then show ?case unfolding 1 using Cons 2 by auto
 qed auto
 
-(* todo for A: look at this and the next *)
-(* TODO: Automatically derive these from strong induction *)
 lemma SA_AllE1[consumes 2, case_names SA_Trans_TVar SA_All]:
   assumes "\ \ \X<:S\<^sub>1. S\<^sub>2 <: T" "X \ dom \"
-    and Top: "\\. \wf \; \X<:S\<^sub>1. S\<^sub>2 closed_in \ \ \ R \ (\X<:S\<^sub>1. S\<^sub>2) Top"
+    and Top: "\\. \wf \;   FFVars_sftypeP (\X<:S\<^sub>1. S\<^sub>2) \ dom \ \ \ R \ (\X<:S\<^sub>1. S\<^sub>2) Top"
     and Forall: "\\ T\<^sub>1 T\<^sub>2. \ \ \ T\<^sub>1 <: S\<^sub>1 ; \,, X<:T\<^sub>1 \ S\<^sub>2 <: T\<^sub>2 \ \ R \ (\X<:S\<^sub>1. S\<^sub>2) (\X<:T\<^sub>1 . T\<^sub>2)"
   shows "R \ (\X<:S\<^sub>1. S\<^sub>2) T"
 using assms(1,2) proof (binder_induction \ "\X<:S\<^sub>1. S\<^sub>2" T avoiding: \ "\X<:S\<^sub>1. S\<^sub>2" T rule: ty.strong_induct)
   case (SA_All \ T\<^sub>1 R\<^sub>1 Y R\<^sub>2 T\<^sub>2)
-  have 1: "\Y<:T\<^sub>1 . T\<^sub>2 = \X<:T\<^sub>1. rrename_Type (id(Y:=X,X:=Y)) T\<^sub>2"
+  have 1: "\Y<:T\<^sub>1 . T\<^sub>2 = \X<:T\<^sub>1. rrename_sftypeP (id(Y:=X,X:=Y)) T\<^sub>2"
     apply (rule Forall_swap)
     using SA_All(6,9) well_scoped(2) by fastforce
-  have fresh: "X \ FFVars_Type T\<^sub>1"
+  have fresh: "X \ FFVars_sftypeP T\<^sub>1"
     by (meson SA_All(4,9) in_mono well_scoped(1))
-  have same: "R\<^sub>1 = S\<^sub>1" using SA_All(8) Type_inject(3) by blast
-  have x: "\Y<:S\<^sub>1. R\<^sub>2 = \X<:S\<^sub>1. rrename_Type (id(Y:=X,X:=Y)) R\<^sub>2"
+  have same: "R\<^sub>1 = S\<^sub>1" using SA_All(8) sftypeP_inject(3) by blast
+  have x: "\Y<:S\<^sub>1. R\<^sub>2 = \X<:S\<^sub>1. rrename_sftypeP (id(Y:=X,X:=Y)) R\<^sub>2"
     apply (rule Forall_swap)
-    by (metis (no_types, lifting) SA_All(8) assms(1,2) in_mono sup.bounded_iff Type.set(4) well_scoped(1))
+    by (metis (no_types, lifting) SA_All(8) assms(1,2) in_mono sup.bounded_iff sftypeP.set(4) well_scoped(1))
   show ?case unfolding 1
     apply (rule Forall)
     using same SA_All(4) apply simp
@@ -108,7 +122,6 @@ using assms(1,2) proof (binder_induction \ "\X<:S\<^sub>1. S\<^su
       apply (rule ty.equiv)
        apply (rule bij_swap supp_swap_bound infinite_var)+
         apply (rule SA_All(6))
-        apply (unfold map_context_def[symmetric])
      apply (subst extend_eqvt)
        apply (rule bij_swap supp_swap_bound infinite_var)+
      apply (rule arg_cong3[of _ _ _ _ _ _ extend])
@@ -120,40 +133,39 @@ qed (auto simp: Top)
 
 lemma SA_AllE2[consumes 2, case_names SA_Trans_TVar SA_All]:
   assumes "\ \ S <: \X<:T\<^sub>1. T\<^sub>2" "X \ dom \"
-    and TyVar: "\\ x U. \ x<:U \ \ ; \ \ U <: \ X <: T\<^sub>1 . T\<^sub>2 ; R \ U (\X<:T\<^sub>1. T\<^sub>2) \ \ R \ (TyVar x) (\ X <: T\<^sub>1 . T\<^sub>2)"
+    and TVr: "\\ x U. \ x<:U \ \ ; \ \ U <: \ X <: T\<^sub>1 . T\<^sub>2 ; R \ U (\X<:T\<^sub>1. T\<^sub>2) \ \ R \ (TVr x) (\ X <: T\<^sub>1 . T\<^sub>2)"
     and Forall: "\\ S\<^sub>1 S\<^sub>2. \ \ \ T\<^sub>1 <: S\<^sub>1 ; \,, X<:T\<^sub>1 \ S\<^sub>2 <: T\<^sub>2 \ \ R \ (\X<:S\<^sub>1. S\<^sub>2) (\ X <: T\<^sub>1 . T\<^sub>2)"
   shows "R \ S (\X<:T\<^sub>1. T\<^sub>2)"
 using assms(1,2) proof (binder_induction \ S "\X<:T\<^sub>1. T\<^sub>2" avoiding: \ S "\X<:T\<^sub>1. T\<^sub>2" rule: ty.strong_induct)
   case (SA_All \ R\<^sub>1 S\<^sub>1 Y S\<^sub>2 R\<^sub>2)
-  have 1: "\Y<:S\<^sub>1. S\<^sub>2 = \X<:S\<^sub>1. rrename_Type (id(Y:=X,X:=Y)) S\<^sub>2"
+  have 1: "\Y<:S\<^sub>1. S\<^sub>2 = \X<:S\<^sub>1. rrename_sftypeP (id(Y:=X,X:=Y)) S\<^sub>2"
     apply (rule Forall_swap)
     using SA_All(6,9) well_scoped(1) by fastforce
   have fresh: "X \ dom \" "Y \ dom \"
     using SA_All(9) apply blast
     by (metis SA_All(6) fst_conv wf_ConsE wf_context)
-  have fresh2: "X \ FFVars_Type T\<^sub>1" "Y \ FFVars_Type T\<^sub>1"
-     apply (metis SA_All(4,8) in_mono fresh(1) Type_inject(3) well_scoped(1))
-    by (metis SA_All(4,8) in_mono fresh(2) Type_inject(3) well_scoped(1))
-  have same: "R\<^sub>1 = T\<^sub>1" using SA_All(8) Type_inject(3) by blast
-  have x: "\Y<:T\<^sub>1 . R\<^sub>2 = \X<:T\<^sub>1. rrename_Type (id(Y:=X,X:=Y)) R\<^sub>2"
+  have fresh2: "X \ FFVars_sftypeP T\<^sub>1" "Y \ FFVars_sftypeP T\<^sub>1"
+     apply (metis SA_All(4,8) in_mono fresh(1) sftypeP_inject(3) well_scoped(1))
+    by (metis SA_All(4,8) in_mono fresh(2) sftypeP_inject(3) well_scoped(1))
+  have same: "R\<^sub>1 = T\<^sub>1" using SA_All(8) sftypeP_inject(3) by blast
+  have x: "\Y<:T\<^sub>1 . R\<^sub>2 = \X<:T\<^sub>1. rrename_sftypeP (id(Y:=X,X:=Y)) R\<^sub>2"
     apply (rule Forall_swap)
-    by (metis SA_All(8) Un_iff assms(1,2) in_mono Type.set(4) well_scoped(2))
+    by (metis SA_All(8) Un_iff assms(1,2) in_mono sftypeP.set(4) well_scoped(2))
   show ?case unfolding 1
     apply (rule Forall)
-     apply (metis SA_All(4,8) Type_inject(3))
+     apply (metis SA_All(4,8) sftypeP_inject(3))
     apply (rule iffD2[OF arg_cong3[OF _ refl, of _ _ _ _ ty], rotated -1])
       apply (rule ty.equiv)
        apply (rule bij_swap supp_swap_bound infinite_var)+
         apply (rule SA_All(6))
-        apply (unfold map_context_def[symmetric])
      apply (subst extend_eqvt)
        apply (rule bij_swap supp_swap_bound infinite_var)+
      apply (rule arg_cong3[of _ _ _ _ _ _ extend])
     using fresh apply (metis bij_swap SA_All(4) Un_iff context_map_cong_id fun_upd_apply id_apply infinite_var supp_swap_bound wf_FFVars wf_context)
       apply simp
-    using fresh2 unfolding same apply (metis bij_swap fun_upd_apply id_apply infinite_var supp_swap_bound Type.rrename_cong_ids)
+    using fresh2 unfolding same apply (metis bij_swap fun_upd_apply id_apply infinite_var supp_swap_bound sftypeP.rrename_cong_ids)
     using SA_All(8) x Forall_inject_same unfolding same by simp
-qed (auto simp: TyVar)
+qed (auto simp: TVr)
 
 lemma ty_transitivity : "\ \ \ S <: Q ; \ \ Q <: T \ \ \ \ S <: T"
   and ty_narrowing : "\ (\ ,, X <: Q),, \ \ M <: N ; \ \ R <: Q \ \ (\,, X <: R),, \ \ M <: N"
@@ -161,32 +173,32 @@ proof -
   have
     ty_trans: "\ \ \ S <: Q ; \ \ Q <: T \ \ \ \ S <: T"
   and ty_narrow: "\ (\,, X <: Q),, \ \ M <: N ; \ \ R <: Q ; wf (\,, X <: R,, \) ; 
-    M closed_in (\,, X <: R,, \) ; N closed_in (\,, X <: R,, \) \ \ (\,, X <: R),, \ \ M <: N"
-  proof (binder_induction Q arbitrary: \ \ S T M N X R avoiding: X "dom \" "dom \" rule: Type.strong_induct)
-    case (TyVar Y \ \ S T M N X R)
+   FFVars_sftypeP M \ dom (\,, X <: R,, \) ; FFVars_sftypeP N \ dom (\,, X <: R,, \) \ \ (\,, X <: R),, \ \ M <: N"
+  proof (binder_induction Q arbitrary: \ \ S T M N X R avoiding: X "dom \" "dom \" rule: sftypeP.strong_induct)
+    case (TVr Y \ \ S T M N X R)
     {
       fix \ S T
-      show ty_trans: "\ \ S <: TyVar Y \ \ \ TyVar Y <: T \ \ \ S <: T"
-        by (induction \ S "TyVar Y" rule: ty.induct) auto
+      show ty_trans: "\ \ S <: TVr Y \ \ \ TVr Y <: T \ \ \ S <: T"
+        by (induction \ S "TVr Y" rule: ty.induct) auto
     } note ty_trans = this
     {
       case 2
       then show ?case
-      proof (binder_induction "\,, X <: TyVar Y,, \" M N arbitrary: \ avoiding: X "dom \" "dom \" rule: ty.strong_induct)
+      proof (binder_induction "\,, X <: TVr Y,, \" M N arbitrary: \ avoiding: X "dom \" "dom \" rule: ty.strong_induct)
         case (SA_Trans_TVar Z U T \')
         show ?case
         proof (cases "X = Z")
           case True
-          then have u: "U = TyVar Y" using SA_Trans_TVar(1,2) context_determ wf_context by blast
-          have "TyVar Y closed_in (\,, Z <: R,, \')" using SA_Trans_TVar(2) True u well_scoped(1) by fastforce
-          then have "\,, Z <: R ,, \' \ TyVar Y <: T" using SA_Trans_TVar True u by auto
-          moreover have "\,, Z <: R,, \' \ R <: TyVar Y" using ty_weakening[OF ty_weakening_extend[OF SA_Trans_TVar(4)]]
+          then have u: "U = TVr Y" using SA_Trans_TVar(1,2) context_determ wf_context by blast
+          have "FFVars_sftypeP (TVr Y) \ dom (\,, Z <: R,, \')" using SA_Trans_TVar(2) True u well_scoped(1) by fastforce
+          then have "\,, Z <: R ,, \' \ TVr Y <: T" using SA_Trans_TVar True u by auto
+          moreover have "\,, Z <: R,, \' \ R <: TVr Y" using ty_weakening[OF ty_weakening_extend[OF SA_Trans_TVar(4)]]
             by (metis SA_Trans_TVar(5) True wf_ConsE wf_concatD)
           ultimately have "\,, Z <: R,, \' \ R <: T" using ty_trans by blast
           then show ?thesis unfolding True u using ty.SA_Trans_TVar by auto
         next
           case False
-          have x: "U closed_in (\,, X <: R,, \')" using SA_Trans_TVar(2) well_scoped(1) by fastforce
+          have x: "FFVars_sftypeP (U) \ dom (\,, X <: R,, \')" using SA_Trans_TVar(2) well_scoped(1) by fastforce
           show ?thesis
             apply (rule ty.SA_Trans_TVar)
             using SA_Trans_TVar False x by auto
@@ -222,7 +234,7 @@ proof -
           then show ?thesis unfolding True u using ty.SA_Trans_TVar by auto
         next
           case False
-          have x: "U closed_in (\,, X <: R,, \')" using SA_Trans_TVar(2) well_scoped(1) by fastforce
+          have x: "FFVars_sftypeP (U) \ dom (\,, X <: R,, \')" using SA_Trans_TVar(2) well_scoped(1) by fastforce
           show ?thesis
             apply (rule ty.SA_Trans_TVar)
             using SA_Trans_TVar False x by auto
@@ -254,7 +266,7 @@ proof -
           then show ?thesis by (meson left(1,3) ty.SA_Arrow ty.SA_Top well_scoped(1))
         next
           case right: (SA_Arrow U\<^sub>1 R\<^sub>1 R\<^sub>2 U\<^sub>2)
-          then show ?thesis using left by (metis Fun(1,3) SA_Arrow Type_inject(2))
+          then show ?thesis using left by (metis Fun(1,3) SA_Arrow sftypeP_inject(2))
         qed auto
       qed auto
     } note ty_trans = this
@@ -267,7 +279,7 @@ proof -
         proof (cases "X = Z")
           case True
           then have u: "U = (Q\<^sub>1 \ Q\<^sub>2)" using SA_Trans_TVar(1,2) context_determ wf_context by blast
-          have "(Q\<^sub>1 \ Q\<^sub>2) closed_in (\,, Z <: R,, \')" using SA_Trans_TVar(2) True u well_scoped(1) by fastforce
+          have "FFVars_sftypeP (Q\<^sub>1 \ Q\<^sub>2) \ dom (\,, Z <: R,, \')" using SA_Trans_TVar(2) True u well_scoped(1) by fastforce
           then have "\,, Z <: R,, \' \ (Q\<^sub>1 \ Q\<^sub>2) <: T" using SA_Trans_TVar True u by auto
           moreover have "\,, Z <: R,, \' \ R <: (Q\<^sub>1 \ Q\<^sub>2)" using ty_weakening[OF ty_weakening_extend[OF SA_Trans_TVar(4)]]
             by (metis SA_Trans_TVar(5) True wf_ConsE wf_concatD)
@@ -275,7 +287,7 @@ proof -
           then show ?thesis unfolding True u using ty.SA_Trans_TVar by auto
         next
           case False
-          have x: "U closed_in (\,, X <: R,, \')" using SA_Trans_TVar(2) well_scoped(1) by fastforce
+          have x: "FFVars_sftypeP U \ dom  (\,, X <: R,, \')" using SA_Trans_TVar(2) well_scoped(1) by fastforce
           show ?thesis
             apply (rule ty.SA_Trans_TVar)
             using SA_Trans_TVar False x by auto
@@ -328,7 +340,7 @@ proof -
         proof (cases "Y = Z")
           case True
           then have u: "U = \ X <: Q\<^sub>1 . Q\<^sub>2" using SA_Trans_TVar(1,2) context_determ wf_context by blast
-          have "\ X <: Q\<^sub>1 . Q\<^sub>2 closed_in \,, Z <: R,, \'" using SA_Trans_TVar(2) True u well_scoped(1) by fastforce
+          have "FFVars_sftypeP (\ X <: Q\<^sub>1 . Q\<^sub>2) \ dom (\,, Z <: R,, \')" using SA_Trans_TVar(2) True u well_scoped(1) by fastforce
           then have "\,, Z <: R,, \' \ \ X <: Q\<^sub>1 . Q\<^sub>2 <: T" using SA_Trans_TVar True u by auto
           moreover have "\,, Z <: R,, \' \ R <: \ X <: Q\<^sub>1 . Q\<^sub>2" using ty_weakening[OF ty_weakening_extend[OF SA_Trans_TVar(4)]]
             by (metis SA_Trans_TVar(5) True wf_ConsE wf_concatD)
@@ -396,10 +408,10 @@ proof -
 qed
 
 theorem ty_transitivity2: "\ \ \ S <: Q ; \ \ Q <: T \ \ \ \ S <: T"
-proof (binder_induction Q arbitrary: \ S T avoiding: "dom \" rule: Type.strong_induct)
-  case (TyVar x \ S T)
+proof (binder_induction Q arbitrary: \ S T avoiding: "dom \" rule: sftypeP.strong_induct)
+  case (TVr x \ S T)
   then show ?case
-    by (induction \ S "TyVar x") auto
+    by (induction \ S "TVr x") auto
 next
   case (Fun x1 x2 \ S T)
   from Fun(4,3) show ?case
@@ -413,8 +425,8 @@ next
       case (SA_Arrow \ U\<^sub>1 R\<^sub>1 R\<^sub>2 U\<^sub>2)
       show ?case
         apply (rule ty.SA_Arrow)
-         apply (metis Fun(1) SA_Arrow(1,5,6,8) Type_inject(2))
-        by (metis Fun(2) SA_Arrow(3,5,7,8) Type_inject(2))
+         apply (metis Fun(1) SA_Arrow(1,5,6,8) sftypeP_inject(2))
+        by (metis Fun(2) SA_Arrow(3,5,7,8) sftypeP_inject(2))
     qed auto
   qed auto
 next
@@ -437,9 +449,9 @@ next
   qed blast
 qed auto
 
-(*
+
 corollary ty_narrowing2: "\ \,, X <: Q,, \ \ M <: N ; \ \ R <: Q \ \ \,, X <: R,, \ \ M <: N"
   using ty_narrowing_aux ty_transitivity2 by blast
-*)
+
 
 end
\ No newline at end of file
diff --git a/thys/POPLmark/SystemFSub.thy b/thys/POPLmark/SystemFSub.thy
index c3841ab4..cf00d0a4 100644
--- a/thys/POPLmark/SystemFSub.thy
+++ b/thys/POPLmark/SystemFSub.thy
@@ -1,52 +1,55 @@
-(* System F with SubTypeing  *)
+(* System F with SubsftypePing  *)
 theory SystemFSub
   imports "SystemFSub_Types"
 begin
 
-abbreviation in_context :: "var \ type \ \\<^sub>\ \ bool" ("_ <: _ \ _" [55,55,55] 60) where
+
+abbreviation in_context :: "var \ sftype \ \\<^sub>\ \ bool" ("_ <: _ \ _" [55,55,55] 60) where
   "x <: t \ \ \ (x, t) \ set \"
-abbreviation well_scoped :: "type \ \\<^sub>\ \ bool" ("_ closed'_in _" [55, 55] 60) where
-  "well_scoped S \ \ FFVars_Type S \ dom \"
+
+abbreviation well_scoped :: "sftype \ \\<^sub>\ \ bool" ("_ closed'_in _" [55, 55] 60) where
+  "well_scoped S \ \ FFVars_sftypeP S \ dom \"
+
 
 inductive wf :: "\\<^sub>\ \ bool"  where
   wf_Nil[intro]: "wf []"
-| wf_Cons[intro!]: "\ x \ dom \ ; T closed_in \ ; wf \\ \ wf (\,,x<:T)"
+| wf_Cons[intro!]: "\ x \ dom \ ; FFVars_sftypeP T \ dom \ ; wf \\ \ wf (\,,x<:T)"
 
 inductive_cases
   wfE[elim]: "wf \"
   and wf_ConsE[elim!]: "wf (a#\)"
 print_theorems
 
-lemma in_context_eqvt:
+lemma in_context_eqvt[equiv]:
   assumes "bij f" "|supp f|  \ \ f x <: rrename_Type f T \ map_context f \"
-  using assms unfolding map_context_def by auto
+  shows "x <: T \ \ \ f x <: rrename_sftypeP f T \ map_context f \"
+  using assms by auto
 
-lemma extend_eqvt:
+lemma extend_eqvt[equiv_commute]:
   assumes "bij f" "|supp f| ,,x<:T) = map_context f \,,f x <: rrename_Type f T"
-  using assms unfolding map_context_def by simp
+  shows "map_context f (\,,x<:T) = map_context f \,,f x <: rrename_sftypeP f T"
+  using assms by simp
 
-lemma closed_in_eqvt:
+lemma closed_in_eqvt[equiv]:
   assumes "bij f" "|supp f|  \ rrename_Type f S closed_in map_context f \"
-  using assms by (auto simp: Type.FFVars_rrenames)
+  shows "FFVars_sftypeP S \ dom \ \ FFVars_sftypeP (rrename_sftypeP f S) \ dom (map_context f \)"
+  using assms context_dom_set by (auto simp: sftypeP.FFVars_rrenames)
 
-lemma wf_eqvt:
+lemma wf_eqvt[equiv]:
   assumes "bij f" "|supp f|  \ wf (map_context f \)"
-unfolding map_context_def proof (induction \)
+proof (induction \)
   case (Cons a \)
   then show ?case using assms apply auto
     apply (metis fst_conv image_iff)
-    using closed_in_eqvt map_context_def by fastforce
+    using closed_in_eqvt by fastforce
 qed simp
 
-abbreviation Tsupp :: "\\<^sub>\ \ type \ type \ var set" where
-  "Tsupp \ T\<^sub>1 T\<^sub>2 \ dom \ \ FFVars_ctxt \ \ FFVars_Type T\<^sub>1 \ FFVars_Type T\<^sub>2"
+abbreviation Tsupp :: "\\<^sub>\ \ sftype \ sftype \ var set" where
+  "Tsupp \ T\<^sub>1 T\<^sub>2 \ dom \ \ FFVars_ctxt \ \ FFVars_sftypeP T\<^sub>1 \ FFVars_sftypeP T\<^sub>2"
 
 lemma small_Tsupp: "small (Tsupp \ T\<^sub>1 T\<^sub>2)"
-  by (auto simp: small_def Type.card_of_FFVars_bounds Type.Un_bound var_Type_pre_class.UN_bound set_bd_UNIV Type.set_bd)
+  by (auto simp: small_def sftypeP.card_of_FFVars_bounds sftypeP.Un_bound var_sftypeP_pre_class.UN_bound set_bd_UNIV sftypeP.set_bd)
 
 lemma fresh: "\xx. xx \ Tsupp \ T\<^sub>1 T\<^sub>2"
   by (metis emp_bound equals0D imageI inf.commute inf_absorb2 small_Tsupp small_def small_isPerm subsetI)
@@ -73,17 +76,17 @@ qed
 
 (* *)
 
-inductive ty :: "\\<^sub>\ \ type \ type \ bool" ("_ \ _ <: _" [55,55,55] 60) where
-  SA_Top: "\wf \; S closed_in \ \ \ \ \ S <: Top"
-| SA_Refl_TVar: "\wf \; TyVar x closed_in \ \ \ \ \ TyVar x <: TyVar x"
-| SA_Trans_TVar: "\ X<:U \ \ ; \ \ U <: T \ \ \ \ TyVar X <: T"
+inductive ty :: "\\<^sub>\ \ sftype \ sftype \ bool" ("_ \ _ <: _" [55,55,55] 60) where
+  SA_Top: "\wf \; FFVars_sftypeP S \ dom \ \ \ \ \ S <: Top"
+| SA_Refl_TVar: "\wf \;  FFVars_sftypeP  (TVr x) \ dom \ \ \ \ \ TVr x <: TVr x"
+| SA_Trans_TVar: "\ X<:U \ \ ; \ \ U <: T \ \ \ \ TVr X <: T"
 | SA_Arrow: "\ \ \ T\<^sub>1 <: S\<^sub>1 ; \ \ S\<^sub>2 <: T\<^sub>2 \ \ \ \ S\<^sub>1 \ S\<^sub>2 <: T\<^sub>1 \ T\<^sub>2"
 | SA_All: "\ \ \ T\<^sub>1 <: S\<^sub>1 ; \,, X<:T\<^sub>1 \ S\<^sub>2 <: T\<^sub>2 \ \ \ \ \X<:S\<^sub>1. S\<^sub>2 <: \X<:T\<^sub>1 .T\<^sub>2"
 
 inductive_cases
   SA_TopE[elim!]: "\ \ Top <: T"
 and
-  SA_TVarE: "\ \ S <: TyVar Z"
+  SA_TVarE: "\ \ S <: TVr Z"
 and
   SA_ArrER: "\ \ S <: T\<^sub>1 \ T\<^sub>2"
 and
@@ -93,33 +96,14 @@ and
 and
   SA_AllEL: "\ \ \Z<:S\<^sub>1. S\<^sub>2 <: T "
 
+
 lemma wf_context: "\ \ S <: T \ wf \"
   by (induction \ S T rule: ty.induct)
 
-lemma well_scoped:
-  assumes "\ \ S <: T"
-  shows "S closed_in \" "T closed_in \"
-using assms proof (induction \ S T rule: ty.induct)
-case (SA_Trans_TVar x U \ T) {
-  case 1 then show ?case using SA_Trans_TVar
-    by (metis fst_conv imageI singletonD subsetI Type.set(1))
-next
-  case 2 then show ?case using SA_Trans_TVar by simp
-} qed auto
-
-declare ty.intros[intro]
-
-lemma ty_fresh_extend: "\,, x <: U \ S <: T \ x \ dom \ \ FFVars_ctxt \ \ x \ FFVars_Type U"
-  by (metis (no_types, lifting) UnE fst_conv snd_conv subsetD wf_ConsE wf_FFVars wf_context)
-
-make_binder_inductive ty
-  subgoal for R B \ \ T1 T2
-    unfolding split_beta
-    by (elim disj_forward exE)
-      (auto simp add: isPerm_def supp_inv_bound map_context_def[symmetric] Type_vvsubst_rrename
-        Type.rrename_comps Type.FFVars_rrenames wf_eqvt extend_eqvt
-        | ((rule exI[of _ "\ _"] exI)+, (rule conjI)?, rule refl)
-        | ((rule exI[of _ "rrename_Type \ _"])+, (rule conjI)?, rule in_context_eqvt))+
+lemma ty_fresh_extend: "\,, x <: U \ S <: T \ x \ dom \ \ FFVars_ctxt \ \ x \ FFVars_sftypeP U"
+by (metis (no_types, lifting) UnE fst_conv snd_conv subsetD wf_ConsE wf_FFVars wf_context)
+
+make_binder_inductive (no_auto_refresh) ty
   subgoal premises prems for R B \ T1 T2
     using prems
     unfolding ex_push_inwards conj_disj_distribL ex_disj_distrib
@@ -144,10 +128,10 @@ make_binder_inductive ty
          apply (drule prems(2)[rule_format, of "id(X := Z, Z := X)" "\,, X <: T\<^sub>1" "S\<^sub>2" "T\<^sub>2", rotated 2])
            apply (auto simp: extend_eqvt)
         apply(rule cong[OF cong[OF cong], THEN iffD1, of R , OF refl, rotated -1, 
-          of _ "rrename_Type (id(X := Z, Z := X)) S\<^sub>2"]) 
+          of _ "rrename_sftypeP (id(X := Z, Z := X)) S\<^sub>2"]) 
           apply (drule ty_fresh_extend)
           apply (simp_all add: supp_swap_bound)
-          by (metis (no_types, opaque_lifting) image_iff map_context_def map_context_swap_FFVars)
+          by (metis (no_types, opaque_lifting) image_iff map_context_swap_FFVars)
       done
     done
   done
diff --git a/thys/POPLmark/SystemFSub_Types.thy b/thys/POPLmark/SystemFSub_Types.thy
index c0be63d5..1af5ee2a 100644
--- a/thys/POPLmark/SystemFSub_Types.thy
+++ b/thys/POPLmark/SystemFSub_Types.thy
@@ -1,4 +1,4 @@
-(* Types for System F with SubTypeing  *)
+(* sftypePs for System F with SubsftypePing  *)
 theory SystemFSub_Types
   imports "Binders.MRBNF_Recursor"
     "Binders.Generic_Strong_Rule_Induction"
@@ -13,73 +13,73 @@ declare supp_id_bound[simp]
 (*type_synonym label = nat*)
 
 declare [[mrbnf_internals]]
-binder_datatype 'var "Type" =
-    TyVar 'var
+binder_datatype 'tvar "sftypeP" =
+    TVr 'tvar
   | Top
-  | Fun "'var Type" "'var Type"
-  | Forall X::'var "'var Type" T::"'var Type" binds X in T
+  | Fun "'tvar sftypeP" "'tvar sftypeP"
+  | Forall X::'tvar "'tvar sftypeP" T::"'tvar sftypeP" binds X in T
 
-declare supp_swap_bound[OF cinfinite_imp_infinite[OF Type.UNIV_cinfinite], simp]
-declare Type.rrename_ids[simp] Type.rrename_id0s[simp]
+declare supp_swap_bound[OF cinfinite_imp_infinite[OF sftypeP.UNIV_cinfinite], simp]
+declare sftypeP.rrename_ids[simp] sftypeP.rrename_id0s[simp]
 
-lemma rrename_Type_simps[simp]:
-  fixes f::"'a::var_Type_pre \ 'a"
+lemma rrename_sftypeP_simps[simp]:
+  fixes f::"'a::var_sftypeP_pre \ 'a"
   assumes "bij f" "|supp f|  X = Y"
+lemma sftypeP_inject:
+  "TVr X = TVr Y \ X = Y"
   "Fun T1 T2 = Fun R1 R2 \ T1 = R1 \ T2 = R2"
   "Forall X T1 T2 = Forall Y R1 R2 \ 
-   T1 = R1 \ (\f. bij (f::'a::var_Type_pre \ 'a) \ 
-   |supp f|  id_on (FFVars_Type T2 - {X}) f \ f X = Y \ rrename_Type f T2 = R2)"
-    apply (unfold TyVar_def Fun_def Forall_def Type.TT_injects0
-      set3_Type_pre_def comp_def Abs_Type_pre_inverse[OF UNIV_I] map_sum.simps sum_set_simps
-      cSup_singleton Un_empty_left Un_empty_right Union_empty image_empty empty_Diff map_Type_pre_def
-      prod.map_id set2_Type_pre_def prod_set_simps prod.set_map UN_single Abs_Type_pre_inject[OF UNIV_I UNIV_I]
+   T1 = R1 \ (\f. bij (f::'a::var_sftypeP_pre \ 'a) \ 
+   |supp f|  id_on (FFVars_sftypeP T2 - {X}) f \ f X = Y \ rrename_sftypeP f T2 = R2)"
+    apply (unfold TVr_def Fun_def Forall_def sftypeP.TT_injects0
+      set3_sftypeP_pre_def comp_def Abs_sftypeP_pre_inverse[OF UNIV_I] map_sum.simps sum_set_simps
+      cSup_singleton Un_empty_left Un_empty_right Union_empty image_empty empty_Diff map_sftypeP_pre_def
+      prod.map_id set2_sftypeP_pre_def prod_set_simps prod.set_map UN_single Abs_sftypeP_pre_inject[OF UNIV_I UNIV_I]
       sum.inject prod.inject map_prod_simp
     )
   by auto
-declare Type_inject(1,2)[simp]
+declare sftypeP_inject(1,2)[simp]
 
 corollary Forall_inject_same[simp]: "Forall X T1 T2 = Forall X S1 S2 \ T1 = S1 \ T2 = S2"
-  using Type_inject(3) Type.rrename_cong_ids
+  using sftypeP_inject(3) sftypeP.rrename_cong_ids
   by (metis (no_types, lifting) Diff_empty Diff_insert0 id_on_insert insert_Diff)
 
 lemma Forall_rrename:
   assumes "bij \" "|supp \| Y. Y\FFVars_Type T2 - {X::'a::var_Type_pre} \ \ Y = Y) \ Forall X T1 T2 = Forall (\ X) T1 (rrename_Type \ T2)"
+ (\Y. Y\FFVars_sftypeP T2 - {X::'a::var_sftypeP_pre} \ \ Y = Y) \ Forall X T1 T2 = Forall (\ X) T1 (rrename_sftypeP \ T2)"
   apply (unfold Forall_def)
-  apply (unfold Type.TT_injects0)
-  apply (unfold set3_Type_pre_def set2_Type_pre_def comp_def Abs_Type_pre_inverse[OF UNIV_I] map_sum.simps
+  apply (unfold sftypeP.TT_injects0)
+  apply (unfold set3_sftypeP_pre_def set2_sftypeP_pre_def comp_def Abs_sftypeP_pre_inverse[OF UNIV_I] map_sum.simps
     map_prod_simp sum_set_simps prod_set_simps cSup_singleton Un_empty_left Un_empty_right
-    Union_empty image_insert image_empty map_Type_pre_def id_def)
+    Union_empty image_insert image_empty map_sftypeP_pre_def id_def)
   apply (rule exI[of _ \])
   apply (rule conjI assms)+
    apply (unfold id_on_def atomize_all atomize_imp)[1]
@@ -88,28 +88,28 @@ lemma Forall_rrename:
   apply (rule refl)
   done
 
-lemma Forall_swap: "y \ FFVars_Type T2 - {x} \ Forall (x::'a::var_Type_pre) T1 T2 = Forall y T1 (rrename_Type (id(x:=y,y:=x)) T2)"
+lemma Forall_swap: "y \ FFVars_sftypeP T2 - {x} \ Forall (x::'a::var_sftypeP_pre) T1 T2 = Forall y T1 (rrename_sftypeP (id(x:=y,y:=x)) T2)"
   apply (rule trans)
    apply (rule Forall_rrename)
      apply (rule bij_swap[of x y])
     apply (rule supp_swap_bound)
-    apply (rule cinfinite_imp_infinite[OF Type.UNIV_cinfinite])
+    apply (rule cinfinite_imp_infinite[OF sftypeP.UNIV_cinfinite])
   by auto
 
 (* Monomorphising: *)
-instance var :: var_Type_pre apply standard
+instance var :: var_sftypeP_pre apply standard
   using Field_natLeq infinite_iff_card_of_nat infinite_var
   by (auto simp add: regularCard_var)
 
-type_synonym type = "var Type"
-type_synonym \\<^sub>\ = "(var \ type) list"
+type_synonym sftype = "var sftypeP"
+type_synonym \\<^sub>\ = "(var \ sftype) list"
 
-definition map_context :: "(var \ var) \ \\<^sub>\ \ \\<^sub>\" where
-  "map_context f \ map (map_prod f (rrename_Type f))"
+abbreviation map_context :: "(var \ var) \ \\<^sub>\ \ \\<^sub>\" where
+  "map_context f \ map (map_prod f (rrename_sftypeP f))"
 
 abbreviation FFVars_ctxt :: "\\<^sub>\ \ var set" where
-  "FFVars_ctxt xs \ \(FFVars_Type ` snd ` set xs)"
-abbreviation extend :: "\\<^sub>\ \ var \ type \ \\<^sub>\" ("_ ,, _ <: _" [57,75,75] 71) where
+  "FFVars_ctxt xs \ \(FFVars_sftypeP ` snd ` set xs)"
+abbreviation extend :: "\\<^sub>\ \ var \ sftype \ \\<^sub>\" ("_ ,, _ <: _" [57,75,75] 71) where
   "extend \ x T \ (x, T)#\"
 abbreviation concat :: "\\<^sub>\ \ \\<^sub>\ \ \\<^sub>\" (infixl "(,,)" 71) where
   "concat \ \ \ \ @ \"
@@ -119,14 +119,13 @@ abbreviation disjoint :: "\\<^sub>\ \ \\<^sub>\ \ \ dom \ \ dom \ = {}"
 
 lemma map_context_id[simp]: "map_context id = id"
-  unfolding map_context_def by simp
+  by simp
 
 lemma map_context_comp0[simp]:
   assumes "bij f" "|supp f|  map_context g = map_context (f \ g)"
   apply (rule ext)
-  unfolding map_context_def
-  using assms by (auto simp: Type.rrename_comps)
+  using assms by (auto simp: sftypeP.rrename_comps)
 
 lemmas map_context_comp = trans[OF comp_apply[symmetric] fun_cong[OF map_context_comp0]]
 declare map_context_comp[simp]
@@ -134,11 +133,11 @@ declare map_context_comp[simp]
 lemma context_dom_set[simp]:
   assumes "bij f" "|supp f| resolve_tac @{context} (BNF_Def.set_bd_of_bnf (the (BNF_Def.bnf_of @{context} @{type_name list}))) 1\)
-  apply (rule var_Type_pre_class.large)
+  apply (rule var_sftypeP_pre_class.large)
   done
 
 lemma context_set_bd_UNIV[simp]: "|dom xs| a. a \ dom \ \ FFVars_ctxt \ \ f a = a"
 shows "map_context f \ = \"
-  unfolding map_context_def
   apply (rule trans)
    apply (rule list.map_cong0[of _ _ id])
    apply (rule trans)
     apply (rule prod.map_cong0[of _ _ id _ id])
-  using assms by (fastforce intro!: Type.rrename_cong_ids)+
+  using assms by (fastforce intro!: sftypeP.rrename_cong_ids)+
 
 lemma ls_UNIV_iff_finite: "|A|  finite A"
 using finite_iff_le_card_var by blast
 
-lemma rrename_swap_FFvars[simp]: "X \ FFVars_Type T \ Y \ FFVars_Type T \
-  rrename_Type (id(X := Y, Y := X)) T = T"
-apply(rule Type.rrename_cong_ids) by auto
+lemma rrename_swap_FFvars[simp]: "X \ FFVars_sftypeP T \ Y \ FFVars_sftypeP T \
+  rrename_sftypeP (id(X := Y, Y := X)) T = T"
+apply(rule sftypeP.rrename_cong_ids) by auto
 
 lemma map_context_swap_FFVars[simp]:
-"\k\set \. X \ fst k \ X \ FFVars_Type (snd k) \
-           Y \ fst k \ Y \ FFVars_Type (snd k) \
+"\k\set \. X \ fst k \ X \ FFVars_sftypeP (snd k) \
+           Y \ fst k \ Y \ FFVars_sftypeP (snd k) \
     map_context (id(X := Y, Y := X)) \ = \"
-  unfolding map_context_def apply(rule map_idI) by auto
+  apply(rule map_idI) by auto
 
 lemma isPerm_swap: "isPerm (id(X := Y, Y := X))"
   unfolding isPerm_def by (auto simp: supp_swap_bound infinite_UNIV)
diff --git a/thys/Pi_Calculus/Commitment.thy b/thys/Pi_Calculus/Commitment.thy
index 91c71b26..d9e695c4 100644
--- a/thys/Pi_Calculus/Commitment.thy
+++ b/thys/Pi_Calculus/Commitment.thy
@@ -338,9 +338,22 @@ fun ns :: "act \ var set" where
 abbreviation "bvars \ bns"
 abbreviation "fvars \ fns"
 
+lemma ns_equiv[equiv]: "bij \ \ |supp \| 
+  \ x \ ns (map_action \ \) \ x \ ns \"
+  by (cases \) auto
+
+lemma fra_equiv[equiv]: "bij \ \ |supp \| 
+  fra (map_action \ \) = fra \"
+  by (cases \) auto
+
 lemma bns_bound: "|bns \|  \ |supp \| 
+ rrename_comP \ (Cmt act P) = Cmt (map_action \ act) (rrename \ P)"
+by (cases act, auto)
+
 local_setup \MRBNF_Sugar.register_binder_sugar "Commitment.comP" {
   ctors = [
     (@{term Finp}, @{thm Finp_def}),
@@ -351,6 +364,10 @@ local_setup \MRBNF_Sugar.register_binder_sugar "Commitment.comP" {
     (@{term Cmt}, @{thm refl})
   ],
   map_simps = [],
+  permute_simps = @{thms
+    rrename_comP_Finp rrename_comP_Fout rrename_comP_Bout
+    rrename_comP_Tau rrename_comP_Binp rrename_comP_Cmt
+  },
   distinct = [],
   bsetss = [[
     NONE,
@@ -360,6 +377,14 @@ local_setup \MRBNF_Sugar.register_binder_sugar "Commitment.comP" {
     SOME @{term "\x1 x2 x3. {x2}"},
     SOME @{term "\x P. bns x"}
   ]],
+  permute_bounds = [
+    [NONE, NONE, NONE],
+    [NONE, NONE, NONE],
+    [NONE, NONE, NONE],
+    [NONE],
+    [NONE, NONE, NONE],
+    [NONE, NONE]
+  ],
   bset_bounds = @{thms bns_bound},
   strong_induct = @{thm refl},
   mrbnf = the (MRBNF_Def.mrbnf_of @{context} "Commitment.comP_pre"),
@@ -369,12 +394,7 @@ local_setup \MRBNF_Sugar.register_binder_sugar "Commitment.comP" {
 
 abbreviation "swapa act x y \ map_action (id(x:=y,y:=x)) act"
 
-lemma bvars_map_action[simp]: "bvars (map_action \ act) = image \ (bvars act)"
-by (cases act, auto)
-
-lemma rrename_comP_Cmt[simp]:
-"bij \ \ |supp \| 
- rrename_comP \ (Cmt act P) = Cmt (map_action \ act) (rrename \ P)"
+lemma bvars_map_action[simp, equiv_simps]: "bvars (map_action \ act) = image \ (bvars act)"
 by (cases act, auto)
 
 lemma bvars_act_bout: "bvars act = {} \ (\a b. act = bout a b) \ (\a b. act = binp a b)"
diff --git a/thys/Pi_Calculus/Pi.thy b/thys/Pi_Calculus/Pi.thy
index 27ecfeb8..8a12530b 100644
--- a/thys/Pi_Calculus/Pi.thy
+++ b/thys/Pi_Calculus/Pi.thy
@@ -20,6 +20,8 @@ for
   vvsubst: vvsubst
   tvsubst: tvsubst
 
+declare procP.FFVars_rrenames[equiv_simps]
+
 (****************************)
 (* DATATYPE-SPECIFIC CUSTOMIZATION  *)
 
@@ -80,21 +82,6 @@ qed
 (* *)
 (* Properties of renaming (variable-for-variable substitution) *)
 
-proposition rrename_simps[simp]:
-  assumes "bij (f::var \ var)" "|supp f| z. (z::var) \ FFVars P \ f z = g z)"
@@ -425,7 +412,7 @@ lemmas usub_simps = usub_simps_free usub_Inp usub_Res
 
 
 
-lemma rrename_usub[simp]:
+lemma rrename_usub[simp, equiv]:
 assumes \: "bij \" "|supp \|  (usub P u (x::var)) = usub (rrename \ P) (\ u) (\ x)"
 using assms
@@ -483,6 +470,11 @@ lemma Inp_eq_usub:
 lemma swap_commute:
 "{y,yy} \ {x,xx} = {} \
  swap (swap P y yy) x xx = swap (swap P x xx) y yy"
-by (auto simp: procP.rrename_comps rrename_cong procP_pre.supp_comp_bound)
+  by (auto simp: procP.rrename_comps rrename_cong procP_pre.supp_comp_bound)
+
+lemma rrename_equiv[equiv]:
+  assumes "bij (f::var\var)" "|supp f|  P = Q"
+  by (simp add: assms(1,2) procP.rrename_bijs)
 
 end
diff --git a/thys/Pi_Calculus/Pi_Transition_Early.thy b/thys/Pi_Calculus/Pi_Transition_Early.thy
index 00349043..6f394bd0 100644
--- a/thys/Pi_Calculus/Pi_Transition_Early.thy
+++ b/thys/Pi_Calculus/Pi_Transition_Early.thy
@@ -2,7 +2,7 @@ theory Pi_Transition_Early
   imports Pi_Transition_Common
 begin
 
-binder_inductive trans :: "proc \ com \ bool" where
+binder_inductive (no_auto_refresh) trans :: "proc \ com \ bool" where
   InpE: "trans (Inp a x P) (Finp a y (P[y/x]))"
 | ComLeftE: "\ trans P (Finp a x P') ; trans Q (Fout a x Q') \ \ trans (P \ Q) (Tau (P' \ Q'))"
 | CloseLeftE: "\ trans P (Finp a x P') ; trans Q (Bout a x Q') ; x \ {a} \ FFVars P \ \ trans (P \ Q) (Tau (Res x (P' \ Q')))"
@@ -10,15 +10,6 @@ binder_inductive trans :: "proc \ com \ bool" where
 | ScopeFree: "\ trans P (Cmt \ P') ; fra \ ; x \ ns \ \ \ trans (Res x P) (Cmt \ (Res x P'))"
 | ScopeBound: "\ trans P (Bout a x P') ; y \ {a, x} ; x \ FFVars P \ {a} \ \ trans (Res y P) (Bout a x (Res y P'))"
 | ParLeft: "\ trans P (Cmt \ P') ; bns \ \ (FFVars P \ FFVars Q) = {} \ \ trans (P \ Q) (Cmt \ (P' \ Q))"
-  subgoal for R B \ x1 x2
-    apply simp
-    apply (elim disj_forward)
-    by (auto simp: isPerm_def
-        procP.rrename_comps action.map_comp action.map_id
-        | ((rule exI[of _ "\ _"] exI)+, (rule conjI)?, rule refl)
-        | (rule exI[of _ "map_action \ _"])
-        | (rule exI[of _ "rrename \ _"])
-        | ((rule exI[of _ "\ _"])+; auto))+
   subgoal premises prems for R B P Q
     (* This is a prototype implemetation of the refreshability heuristic mentioned in sections 5 and 6. *)  
     by (tactic \refreshability_tac false
diff --git a/thys/Pi_Calculus/Pi_Transition_Late.thy b/thys/Pi_Calculus/Pi_Transition_Late.thy
index 71994622..691dabd3 100644
--- a/thys/Pi_Calculus/Pi_Transition_Late.thy
+++ b/thys/Pi_Calculus/Pi_Transition_Late.thy
@@ -2,7 +2,7 @@ theory Pi_Transition_Late
   imports Pi_Transition_Common
 begin
 
-binder_inductive trans :: "proc \ com \ bool" where
+binder_inductive (no_auto_refresh) trans :: "proc \ com \ bool" where
   InpL: "trans (Inp a x P) (Binp a x P)"
 | ComLeftL: "\ trans P (Binp a x P') ; trans Q (Fout a y Q') \ \ trans (P \ Q) (Tau ((P'[y/x]) \ Q'))"
 | CloseLeftL: "\ trans P (Binp a x P') ; trans Q (Bout a x Q') \ \ trans (P \ Q) (Tau (Res x (P' \ Q')))"
@@ -10,14 +10,6 @@ binder_inductive trans :: "proc \ com \ bool" where
 | ScopeFree: "\ trans P (Cmt \ P') ; fra \ ; x \ ns \ \ \ trans (Res x P) (Cmt \ (Res x P'))"
 | ScopeBound: "\ trans P (Bout a x P') ; y \ {a, x} ; x \ FFVars P \ {a} \ \ trans (Res y P) (Bout a x (Res y P'))"
 | ParLeft: "\ trans P (Cmt \ P') ; bns \ \ (FFVars P \ FFVars Q) = {} \ \ trans (P \ Q) (Cmt \ (P' \ Q))"
-  subgoal for R B \ x1 x2
-    apply simp
-    apply (elim disj_forward)
-    by (auto simp: isPerm_def
-        procP.rrename_comps action.map_comp action.map_id
-        | ((rule exI[of _ "\ _"] exI)+, (rule conjI)?, rule refl)
-        | (rule exI[of _ "map_action \ _"] exI[of _ "rrename \ _"])
-        | ((rule exI[of _ "\ _"])+; auto))+
   subgoal premises prems for R B P Q
     (* This is a prototype implementation of the refreshability heuristic mentioned in sections 5 and 6. *)
     by (tactic \refreshability_tac false
diff --git a/thys/Pi_Calculus/Pi_cong.thy b/thys/Pi_Calculus/Pi_cong.thy
index 95c0610c..707bfdec 100644
--- a/thys/Pi_Calculus/Pi_cong.thy
+++ b/thys/Pi_Calculus/Pi_cong.thy
@@ -9,7 +9,7 @@ lemma fresh: "\xx. xx \ Tsupp (t :: proc) t2"
   by (metis (no_types, lifting) exists_var finite_iff_le_card_var procP.Un_bound procP.set_bd_UNIV)
 
 (* Structural congurence *)
-binder_inductive cong :: "proc \ proc \ bool" (infix "(\\<^sub>\)" 40) where
+binder_inductive (no_auto_refresh) cong :: "proc \ proc \ bool" (infix "(\\<^sub>\)" 40) where
   "P = Q \ P \\<^sub>\ Q"
 | "Par P Q \\<^sub>\ Par Q P"
 | "Par (Par P Q) R \\<^sub>\ Par P (Par Q R)"
@@ -17,13 +17,7 @@ binder_inductive cong :: "proc \ proc \ bool" (infix "(\
 | "x \ y \ Res x (Res y P) \\<^sub>\ Res y (Res x P)"
 | "Res x Zero \\<^sub>\ Zero"
 | "Bang P \\<^sub>\ Par P (Bang P)"
-| cong_3: "x \ FFVars Q \ Res x (Par P Q) \\<^sub>\ Par (Res x P) Q"
-  subgoal for R B \ x1 x2
-    apply simp
-    by (elim disj_forward case_prodE)
-      (auto simp: isPerm_def procP.rrename_comps
-        | ((rule exI[of _ "\ _"] exI)+, (rule conjI)?, rule refl)
-        | ((rule exI[of _ "\ _"])+; auto))+
+| "x \ FFVars Q \ Res x (Par P Q) \\<^sub>\ Par (Res x P) Q"
   subgoal premises prems for R B x1 x2
     apply simp
     using fresh[of x1 x2] prems(2-) unfolding
@@ -54,7 +48,7 @@ proof-
   thus ?thesis by auto
 qed
 
-binder_inductive trans :: "proc \ proc \ bool" (infix "(\)" 30) where
+binder_inductive (no_auto_equiv, no_auto_refresh) trans :: "proc \ proc \ bool" (infix "(\)" 30) where
   "Par (Out x z P) (Inp x y Q) \ Par P (usub Q z y)"
 | "P \ Q \ Par P R \ Par P Q"
 | "P \ Q \ Res x P \ Res x Q"
diff --git a/thys/Untyped_Lambda_Calculus/LC.thy b/thys/Untyped_Lambda_Calculus/LC.thy
index 05ef95f3..8326dea0 100644
--- a/thys/Untyped_Lambda_Calculus/LC.thy
+++ b/thys/Untyped_Lambda_Calculus/LC.thy
@@ -28,7 +28,7 @@ instance var :: var_ltermP_pre apply standard
   by (auto simp add: regularCard_var)
 
 instance var::cinf
-apply standard 
+apply standard
   subgoal apply(rule exI[of _ "inv Variable"])
   by (simp add: bij_Variable bij_is_inj)
   subgoal using infinite_var . .
@@ -58,8 +58,8 @@ lemma FFVars_tvsubst[simp]:
   using ltermP.FVars_VVr apply (auto simp add: SSupp_def)
   by (smt (verit) singletonD ltermP.FVars_VVr)
 
-lemma fsupp_le[simp]: 
-"fsupp (\::var\var) \ |supp \| ::var\var) \ |supp \|  var)" "|supp f| z. (z::var) \ FFVars P \ f z = g z)"
@@ -156,10 +146,10 @@ proof-
     using fg var_ltermP_pre_class.Un_bound by blast
   show ?thesis using 0 eq apply(binder_induction P avoiding: "IImsupp f" "IImsupp g" rule: ltermP.strong_induct)
     subgoal using fg by auto
-    subgoal using fg by simp  
+    subgoal using fg by simp
     subgoal using f g by simp
     subgoal using f g by simp
-    subgoal using f g fg apply simp unfolding IImsupp_def SSupp_def 
+    subgoal using f g fg apply simp unfolding IImsupp_def SSupp_def
     by auto metis .
 qed
 
@@ -288,8 +278,7 @@ lemma Lm_avoid: "|A::var set|  \x' e
 lemma Lm_rrename:
 "bij (\::var\var) \ |supp \| 
  (\a'. a' \FFVars_ltermP e - {a::var} \ \ a' = a') \ Lm a e = Lm (\ a) (rrename \ e)"
-by (metis rrename_simps(3) ltermP.rrename_cong_ids ltermP.set(3))
-
+by (metis ltermP.permute(3) ltermP.rrename_cong_ids ltermP.set(3))
 
 (* Bound properties (needed as auxiliaries): *)
 
@@ -301,14 +290,72 @@ lemma SSupp_upd_bound:
       elim!: ordLeq_ordLess_trans[OF card_of_mono1 ordLess_ordLeq_trans[OF ltermP_pre.Un_bound], rotated, of _ "{a}"]
       intro: card_of_mono1)
 
+lemma SSupp_upd_Vr_bound[simp,intro!]: "|SSupp (Vr(x::'a := t))| ::"'a::var_ltermP_pre \ 'a"
+  assumes "bij \" "|supp \|  (tvsubst (Vr(x := t')) t) = tvsubst (Vr(\ x := rrename \ t')) (rrename \ t)"
+  apply (rule trans)
+   apply (rule trans[OF comp_apply[symmetric] ltermP.rrename_tvsubst[THEN fun_cong]])
+     apply (rule assms)+
+   apply (rule SSupp_upd_Vr_bound)
+  apply (unfold comp_def fun_upd_def)
+  apply (rule arg_cong2[OF _ refl, of _ _ tvsubst])
+  apply (rule ext)
+  apply (rule case_split)
+   apply (rule sym)
+   apply (rule trans[OF if_P])
+    apply (erule sym)
+   apply (subst if_P)
+    apply (erule subst)
+    apply (rule inv_simp1)
+    apply (rule assms)
+   apply (rule refl)
+  apply (subst if_not_P)
+   apply (erule contrapos_nn)
+   apply hypsubst_thin
+   apply (rule inv_simp2)
+   apply (rule assms)
+  apply (subst if_not_P)
+   apply (erule contrapos_nn)
+   apply (erule sym)
+  apply (rule trans)
+   apply (rule ltermP.permute)
+    apply (rule assms)+
+  apply (rule arg_cong[of _ _ Vr])
+  apply (rule inv_simp2)
+  apply (rule assms)
+  done
+
+lemma fun_upd_equiv[equiv]:
+  fixes \::"'a::var_ltermP_pre \ 'a"
+  assumes "bij \" "|supp \| x. rrename \ (f x) = f (\ x)"
+  shows "rrename \ ((f(x := t)) y) = (f(\ x := rrename \ t)) (\ y)"
+  apply (unfold comp_def fun_upd_def)
+  apply (rule case_split)
+   apply (subst if_P)
+    apply assumption
+   apply hypsubst_thin
+   apply (subst if_P)
+    apply (rule refl)
+   apply (rule refl)
+  apply (unfold if_not_P)
+  apply (subst if_not_P)
+   apply (erule contrapos_nn)
+   apply (erule injD[OF bij_is_inj, rotated])
+   apply (rule assms)
+  apply (rule equiv)
+  done
+
 corollary SSupp_upd_VVr_bound[simp,intro!]: "|SSupp (VVr(a:=(t::lterm)))|  {x,xx} \ rrename (id(x := xx, xx := x)) (Vr (z::var)) = Vr z"
-apply(subst rrename_simps(1)) by auto
+apply(subst ltermP.permute(1)) by auto
 lemma rrename_swap_Vr[simp]: "rrename (id(x := xx, xx := x)) (Vr (z::var)) =
  Vr (if z = x then xx else if z = xx then x else z)"
-apply(subst rrename_simps(1)) by auto
+apply(subst ltermP.permute(1)) by auto
 
 (* Compositionality properties of renaming and ltermP-for-variable substitution *)
 
@@ -687,7 +734,7 @@ by (simp add: fsupp_supp permut_rrename toPerm_toSwp)
 (* *)
 (* Substitution from a sequence (here, a list) *)
 
-(* "making" the substitution function that maps each xs_i to es_i; only 
+(* "making" the substitution function that maps each xs_i to es_i; only
 meaningful if xs is non-repetitive *)
 definition "mkSubst xs es \ \x. if distinct xs \ x \ set xs then nth es (theN xs x) else Vr x"
 
@@ -698,7 +745,7 @@ lemma mkSubst_idle[simp]: "\ distinct xs \ \ x \ set xs \::var\var)" "|supp \| ::var\var)" "|supp \|  xs) (map (rrename \) es2) \ \ = rrename \ \ mkSubst xs es2"
-proof(rule ext)  
+proof(rule ext)
   fix x
   show "(mkSubst (map \ xs) (map (rrename \) es2) \ \) x = (rrename \ \ mkSubst xs es2) x"
   proof(cases "distinct xs \ x \ set xs")
@@ -719,7 +766,7 @@ proof(rule ext)
     hence F: "\ distinct (map \ xs) \ \ \ x \ set (map \ xs)"
     using s by auto
     thus ?thesis using F False
-    unfolding o_def apply(subst mkSubst_idle) 
+    unfolding o_def apply(subst mkSubst_idle)
       subgoal by auto
       subgoal using s by auto .
   next
@@ -728,14 +775,14 @@ proof(rule ext)
     hence T: "distinct (map \ xs)" and Ti: "\ x = nth (map \ xs) i"
     using s by auto
     thus ?thesis using T Tr
-    unfolding o_def Ti apply(subst mkSubst_nth) 
+    unfolding o_def Ti apply(subst mkSubst_nth)
       subgoal by auto
-      subgoal using i unfolding Tri by auto 
+      subgoal using i unfolding Tri by auto
       subgoal using l i unfolding Tri by auto .
   qed
 qed
 
-lemma mkSubst_map_rrename_inv: 
+lemma mkSubst_map_rrename_inv:
 assumes "bij (\::var\var)" "|supp \|  xs) (map (rrename \) es2) = rrename \ \ mkSubst xs es2 o inv \"
 unfolding mkSubst_map_rrename[OF assms, symmetric] using assms unfolding fun_eq_iff by auto
@@ -746,16 +793,16 @@ lemma card_SSupp_itvsubst_mkSubst_rrename_inv:
 |SSupp (tvsubst (rrename \ \ mkSubst xs es \ inv \) \ (Vr \ \))| ::var\var) \ |supp \|  
- length es = length xs \ 
+lemma card_SSupp_mkSubst_rrename_inv:
+"bij (\::var\var) \ |supp \| 
+ length es = length xs \
  |SSupp (rrename \ \ mkSubst xs es \ inv \)|  distinct xs \ z \ set xs \ 
- length es = length xs \ 
+lemma mkSubst_smap: "bij f \ distinct xs \ z \ set xs \
+ length es = length xs \
  mkSubst (map f xs) es (f z) = mkSubst xs es z"
-by (metis bij_distinct_smap distinct_Ex1 length_map mkSubst_nth nth_map) 
+by (metis bij_distinct_smap distinct_Ex1 length_map mkSubst_nth nth_map)
 
 
 (* *)
@@ -774,13 +821,11 @@ proof-
       subgoal apply(rule tvsubst_cong)
         subgoal by simp
         subgoal by (simp add: SSupp_tvsubst_bound f(2))
-        subgoal apply simp 
+        subgoal apply simp
      subgoal using f(1) f(3) id_onD by fastforce . . . .
 qed
 
 
-
-
 (* RECURSOR PREPARATIONS: *)
 
 thm Lm_inject[no_vars]
@@ -849,14 +894,14 @@ qed
 
 (* RECURSOR *)
 
-locale LC_Rec = 
+locale LC_Rec =
 fixes B :: "'b set"
 and VrB :: "var \ 'b" 
 and ApB :: "'b \ 'b \ 'b"
 and LmB :: "var \ 'b \ 'b"
 and renB :: "(var \ var) \ 'b \ 'b"
 and FVarsB :: "'b \ var set"
-assumes 
+assumes
 (* closedness: *)
 VrB_B[simp,intro]: "\x. VrB x \ B"
 and 
@@ -865,22 +910,22 @@ and
 LmB_B[simp,intro]: "\x b. b \  B \ LmB x b \ B"
 and 
 renB_B[simp]: "\\ b. bij \ \ |supp \|  b \ B \ renB \ b \ B"
-and 
+and
 (* proper axioms: *)
 renB_id[simp,intro]: "\b. b \ B \ renB id b = b"
-and 
-renB_comp[simp,intro]: "\b \ \. bij \ \ |supp \|  
+and
+renB_comp[simp,intro]: "\b \ \. bij \ \ |supp \| 
     bij \ \ |supp \|  b \ B \ renB (\ o \) b = renB \ (renB \ b)"
-and 
-renB_cong[simp]: "\\ b. bij \ \ |supp \|  
-   (\x \ FVarsB b. \ x = x) \ 
+and
+renB_cong[simp]: "\\ b. bij \ \ |supp \| 
+   (\x \ FVarsB b. \ x = x) \
    renB \ b = b"
-(* and 
-NB: This is redundant:  
-renB_FVarsB[simp]: "\\ x b. bij \ \ |supp \|  
+(* and
+NB: This is redundant:
+renB_FVarsB[simp]: "\\ x b. bij \ \ |supp \| 
    x \ FVarsB (renB \ b) \ inv \ x \ FVarsB b"
 *)
-and 
+and
 (* *)
 renB_VrB[simp]: "\\ x. bij \ \ |supp \|  renB \ (VrB x) = VrB (\ x)"
 and 
@@ -920,8 +965,8 @@ qed
 lemma LmB_inject_strong'_rev: 
 assumes bb': "{b,b'} \ B"  
 and z: "z = x \ z \ FVarsB b" "z = x' \ z \ FVarsB b'"
-and f: "bij f" "|supp f| x' e' b'. R e' b' \ Lm x e = Lm x' e' \ b = LmB x' b'"
 using assms by (cases rule: R.cases) auto
 
-lemma R_total: 
+lemma R_total:
 "\b. R e b"
 apply(induct e) by (auto intro: R.intros)
 
-lemma R_B: 
+lemma R_B:
 "R e b \ b \ B"
 apply(induct rule: R.induct) by auto
 
-lemma R_main: 
-"(\b b'. R e b \ R e b' \ b = b') \ 
- (\b. R e b \ FVarsB b \ FFVars e) \ 
+lemma R_main:
+"(\b b'. R e b \ R e b' \ b = b') \
+ (\b. R e b \ FVarsB b \ FFVars e) \
  (\b f. R e b \ bij f \ |supp f|  R (rrename f e) (renB f b))"
 proof(induct e rule: lterm_rrename_induct)
@@ -1000,7 +1045,7 @@ next
       R_B Un_iff bot.extremum insert_Diff insert_subset)
     subgoal apply(drule R_Ap_elim) 
       by (smt (verit, del_insts) R.simps R_B bot.extremum insert_subset renB_ApB 
-      rrename_simps(2)) .
+      ltermP.permute(2)) .
 next
   case (Lm x t)
   note Lmm = Lm[rule_format]
@@ -1025,7 +1070,7 @@ next
     "z \ {x,x1',x2'} \ FFVars t \ FFVars t1' \ FFVars t2'" 
     by (meson exists_fresh)
 
-    obtain f1 f1' where 
+    obtain f1 f1' where
     f1: "bij f1" "|supp f1|  id_on (FFVars (Lm x t)) f1" and 
     f1': "bij f1'" "|supp f1'|  FFVars t1'"
     using Lm2[OF if1', unfolded t1'[symmetric], OF 1(1)] .
 
-    obtain f2 f2' where 
+    obtain f2 f2' where
     f2: "bij f2" "|supp f2|  id_on (FFVars (Lm x t)) f2" and 
     f2': "bij f2'" "|supp f2'|  f1) t) = rrename f1 t" 
+
+    have rew1: "rrename f1' (rrename (inv f1' \ f1) t) = rrename f1 t"
     using f1f1' t1' by auto
 
     have rew2: "rrename ff2' (rrename (inv f2' \ f2) t) = rrename f1 t" 
@@ -1112,7 +1157,7 @@ next
     "z \ {x,x'} \ FFVars t \ FFVars t'" 
     by (meson exists_fresh)
 
-    obtain f where 
+    obtain f where
     f: "bij f" "|supp f|  id_on (FFVars (Lm x t)) f" 
     and z: "f x = x'"   
@@ -1130,7 +1175,7 @@ next
 
     assume "R (Lm x t) b" and f: "bij f" "|supp f|  {x,x'} \ FFVars t \ FFVars t'" 
     by (meson exists_fresh)
 
-    obtain g where 
+    obtain g where
     g: "bij g" "|supp g|  id_on (FFVars (Lm x t)) g" 
     and z: "g x = x'"   
@@ -1159,7 +1204,7 @@ next
       subgoal by fact subgoal by fact .
 
     show "R (rrename f (Lm x t)) (renB f b)" 
-    unfolding 0 using RR apply(subst rrename_simps) 
+    unfolding 0 using RR apply(subst ltermP.permute) 
       subgoal using f by auto subgoal using f by auto
       subgoal apply(subst renB_LmB)
        using f b' by auto .  
@@ -1201,7 +1246,7 @@ using morFromTrm_rec unfolding morFromTrm_def by auto
 lemma rec_Lm[simp]: "rec (Lm x e) = LmB x (rec e)"
 using morFromTrm_rec unfolding morFromTrm_def by auto
 
-lemma rec_rrename: "bij \ \ |supp \|  
+lemma rec_rrename: "bij \ \ |supp \| 
  rec (rrename \ e) = renB \ (rec e)"
 using morFromTrm_rec unfolding morFromTrm_def by auto
 
@@ -1220,8 +1265,10 @@ using assms by auto .
 
 end (* context LC_Rec *)
 
-
-
-
+lemmas smalls = emp_bound singl_bound ltermP.Un_bound infinite ltermP.card_of_FFVars_bounds
+declare smalls[refresh_smalls]
+declare Lm_inject[refresh_simps]
+declare Lm_eq_tvsubst[refresh_intros] ltermP.rrename_cong_ids[symmetric, refresh_intros]
+declare id_on_antimono[refresh_elims]
 
 end
diff --git a/thys/Untyped_Lambda_Calculus/LC_Beta.thy b/thys/Untyped_Lambda_Calculus/LC_Beta.thy
index 08696a79..e5a771c9 100644
--- a/thys/Untyped_Lambda_Calculus/LC_Beta.thy
+++ b/thys/Untyped_Lambda_Calculus/LC_Beta.thy
@@ -13,19 +13,7 @@ binder_inductive step :: "lterm \ lterm \ bool" where
   Beta: "step (Ap (Lm x e1) e2) (tvsubst (Vr(x:=e2)) e1)"
 | ApL: "step e1 e1' \ step (Ap e1 e2) (Ap e1' e2)"
 | ApR: "step e2 e2' \ step (Ap e1 e2) (Ap e1 e2')"
-| Xi: "step e e' \ step (Lm x e) (Lm x e')"
-  subgoal for \ R B t  \ \equivariance\
-    by (elim disj_forward case_prodE)
-      (auto simp: isPerm_def ltermP.rrename_comps rrename_tvsubst_comp
-         | ((rule exI[of _ "\ _"] exI)+, (rule conjI)?, rule refl)
-         | ((rule exI[of _ "\ _"])+; auto))+
-  subgoal premises prems for R B x1 x2  \ \refreshability\
-    using fresh[of x1 x2] prems(2-) unfolding isPerm_def conj_assoc[symmetric] split_beta
-    unfolding ex_push_inwards conj_disj_distribL ex_disj_distrib
-    apply (elim disj_forward exE; simp)
-     apply (metis Lm_eq_tvsubst Lm_inject_swap singletonD)
-    by blast
-    done
+| Xi: "step e e' \ step (Lm x e) (Lm x e')" .
 
 thm step.strong_induct 
 thm step.equiv
@@ -39,4 +27,4 @@ lemma red_step2: "stream_all2 red es ees \ stream_all2 step es e
 unfolding stream_all2_iff_snth using red_step by auto
 
 
-end
\ No newline at end of file
+end
diff --git a/thys/Untyped_Lambda_Calculus/LC_Beta_depth.thy b/thys/Untyped_Lambda_Calculus/LC_Beta_depth.thy
index e8a74c23..dade322e 100644
--- a/thys/Untyped_Lambda_Calculus/LC_Beta_depth.thy
+++ b/thys/Untyped_Lambda_Calculus/LC_Beta_depth.thy
@@ -17,19 +17,7 @@ binder_inductive stepD :: "nat \ lterm \ lterm \ stepD (Suc d) (Ap e1 e2) (Ap e1' e2)"
 | ApR: "stepD d e2 e2' \ stepD (Suc d) (Ap e1 e2) (Ap e1 e2')"
-| Xi: "stepD d e e' \ stepD d (Lm x e) (Lm x e')"
-  subgoal for R B \ x1 x2 x3
-    by (elim disj_forward exE case_prodE)
-      (auto simp: isPerm_def ltermP.rrename_comps rrename_tvsubst_comp
-        | ((rule exI[of _ "\ _"] exI)+, (rule conjI)?, rule refl)
-        | ((rule exI[of _ "\ _"])+; auto))+
-  subgoal premises prems for R B x1 x2 x3
-    using fresh[of x2 x3] prems(2-)
-    unfolding ex_push_inwards conj_disj_distribL ex_disj_distrib
-    apply (elim disj_forward exE; simp)
-     apply (metis Lm_eq_tvsubst Lm_refresh singletonD)
-    by blast
-  done
+| Xi: "stepD d e e' \ stepD d (Lm x e) (Lm x e')" .
 
 thm stepD.strong_induct
 thm stepD.equiv
@@ -43,4 +31,4 @@ lemma red_stepD2: "stream_all2 red es ees \ stream_all2 (stepD 0
 unfolding stream_all2_iff_snth using red_stepD by auto
 
 
-end
\ No newline at end of file
+end
diff --git a/thys/Untyped_Lambda_Calculus/LC_Parallel_Beta.thy b/thys/Untyped_Lambda_Calculus/LC_Parallel_Beta.thy
index 2124ec0a..6bdb573b 100644
--- a/thys/Untyped_Lambda_Calculus/LC_Parallel_Beta.thy
+++ b/thys/Untyped_Lambda_Calculus/LC_Parallel_Beta.thy
@@ -9,17 +9,11 @@ abbreviation Tsupp where "Tsupp a b \ FFVars a \ FFVars b"
 lemma fresh: "\xx. xx \ Tsupp (t1 :: lterm) t2"
   by (metis (no_types, lifting) exists_var finite_iff_le_card_var ltermP.Un_bound ltermP.set_bd_UNIV)
 
-binder_inductive pstep :: "lterm \ lterm \ bool" where
+binder_inductive (no_auto_refresh) pstep :: "lterm \ lterm \ bool" where
   Refl: "pstep e e"
 | Ap: "pstep e1 e1' \ pstep e2 e2' \ pstep (Ap e1 e2) (Ap e1' e2')"
 | Xi: "pstep e e' \ pstep (Lm x e) (Lm x e')"
 | PBeta: "pstep e1 e1' \ pstep e2 e2' \ pstep (Ap (Lm x e1) e2) (tvsubst (Vr(x:=e2')) e1')"
-  subgoal for \ R B x1 x2
-    by (elim disj_forward exE)
-      (auto simp: isPerm_def
-         ltermP.rrename_comps rrename_tvsubst_comp
-         | ((rule exI[of _ "\ _"] exI)+, (rule conjI)?, rule refl)
-         | ((rule exI[of _ "\ _"])+; auto))+
   subgoal premises prems for R B x1 x2
     using fresh[of x1 x2] prems(2-)
     unfolding ex_push_inwards conj_disj_distribL ex_disj_distrib
@@ -59,4 +53,4 @@ binder_inductive pstep :: "lterm \ lterm \ bool" where
 thm pstep.strong_induct
 thm pstep.equiv
 
-end
\ No newline at end of file
+end