diff --git a/thys/ResiduatedTransitionSystem/LambdaCalculus.thy b/thys/ResiduatedTransitionSystem/LambdaCalculus.thy
--- a/thys/ResiduatedTransitionSystem/LambdaCalculus.thy
+++ b/thys/ResiduatedTransitionSystem/LambdaCalculus.thy
@@ -1,10924 +1,10876 @@
 chapter "The Lambda Calculus"
 
   text \<open>
     In this second part of the article, we apply the residuated transition system framework
     developed in the first part to the theory of reductions in Church's \<open>\<lambda>\<close>-calculus.
     The underlying idea is to exhibit \<open>\<lambda>\<close>-terms as states (identities) of an RTS,
     with reduction steps as non-identity transitions.  We represent both states and transitions
     in a unified, variable-free syntax based on de Bruijn indices.
     A difficulty one faces in regarding the \<open>\<lambda>\<close>-calculus as an RTS is that
     ``elementary reductions'', in which just one redex is contracted, are not preserved by
     residuation: an elementary reduction can have zero or more residuals along another
     elementary reduction.  However, ``parallel reductions'', which permit the contraction of
     multiple redexes existing in a term to be contracted in a single step, are preserved
     by residuation.  For this reason, in our syntax each term represents a parallel reduction
     of zero or more redexes; a parallel reduction of zero redexes representing an identity.
     We have syntactic constructors for variables, \<open>\<lambda>\<close>-abstractions, and applications.
     An additional constructor represents a \<open>\<beta>\<close>-redex that has been marked for contraction.
     This is a slightly different approach that that taken by other authors
     (\emph{e.g.}~\cite{barendregt} or \cite{huet-residual-theory}), in which it is the
     application constructor that is marked to indicate a redex to be contracted,
     but it seems more natural in the present setting in which a single syntax is used to
     represent both terms and reductions.
 
     Once the syntax has been defined, we define the residuation operation and prove
     that it satisfies the conditions for a weakly extensional RTS.  In this RTS, the source
     of a term is obtained by ``erasing'' the markings on redexes, leaving an identity term.
     The target of a term is the contractum of the parallel reduction it represents.
     As the definition of residuation involves the use of substitution, a necessary prerequisite
     is to develop the theory of substitution using de Bruijn indices.
     In addition, various properties concerning the commutation of residuation and substitution
     have to be proved.  This part of the work has benefited greatly from previous work
     of Huet \cite{huet-residual-theory}, in which the theory of residuation was formalized
     in the proof assistant Coq.  In particular, it was very helpful to have already available
     known-correct statements of various lemmas regarding indices, substitution, and residuation.
     The development of the theory culminates in the proof of L\'{e}vy's ``Cube Lemma''
     \cite{levy}, which is the key axiom in the definition of RTS.
 
     Once reductions in the \<open>\<lambda>\<close>-calculus have been cast as transitions of an RTS,
     we are able to take advantage of generic results already proved for RTS's; in particular,
     the construction of the RTS of paths, which represent reduction sequences.
     Very little additional effort is required at this point to prove the Church-Rosser Theorem.
     Then, after proving a series of miscellaneous lemmas about reduction paths,
     we turn to the study of developments.  A development of a term is a reduction path from
     that term in which the only redexes that are contracted are those that are residuals of
     redexes in the original term.  We prove the Finite Developments Theorem: all developments
     are finite.  The proof given here follows that given by de Vrijer \cite{deVrijer},
     except that here we make the adaptations necessary for a syntax based on de Bruijn
     indices, rather than the classical named-variable syntax used by de Vrijer.
     Using the Finite Developments Theorem, we define a function that takes a term and constructs
     a ``complete development'' of that term, which is a development in which no residuals of
     original redexes remain to be contracted.
 
     We then turn our attention to ``standard reduction paths'', which are reduction paths in
     which redexes are contracted in a left-to-right order, perhaps with some skips.
     After giving a definition of standard reduction paths, we define a function that takes a
     term and constructs a complete development that is also standard.
     Using this function as a base case, we then define a function that takes an arbitrary
     parallel reduction path and transforms it into a standard reduction path that is congruent
     to the given path.  The algorithm used is roughly analogous to insertion sort.
     We use this function to prove strong form of the Standardization Theorem: every reduction
     path is congruent to a standard reduction path.  As a corollary of the Standardization
     Theorem, we prove the Leftmost Reduction Theorem: leftmost reduction is a normalizing
     reduction strategy.
 
     It should be noted that, in this article, we consider only the \<open>\<lambda>\<beta>\<close>-calculus.
     In the early stages of this work, I made an exploratory attempt to incorporate \<open>\<eta>\<close>-reduction
     as well, but after encountering some unanticipated difficulties I decided not to attempt that
     extension until the \<open>\<beta>\<close>-only case had been well-developed.
   \<close>
 
 theory LambdaCalculus
 imports Main ResiduatedTransitionSystem
 begin
 
   section "Syntax"
 
   locale lambda_calculus
   begin
 
     text \<open>
       The syntax of terms has constructors \<open>Var\<close> for variables, \<open>Lam\<close> for \<open>\<lambda>\<close>-abstraction,
       and \<open>App\<close> for application.  In addition, there is a constructor \<open>Beta\<close> which is used
       to represent a \<open>\<beta>\<close>-redex that has been marked for contraction.  The idea is that
       a term \<open>Beta t u\<close> represents a marked version of the term \<open>App (Lam t) u\<close>.
       Finally, there is a constructor \<open>Nil\<close> which is used to represent the null element
       required for the residuation operation.
     \<close>
 
     datatype (discs_sels) lambda =
       Nil
     | Var nat
     | Lam lambda
     | App lambda lambda
     | Beta lambda lambda
 
     text \<open>
       The following notation renders \<open>Beta t u\<close> as a ``marked'' version of \<open>App (Lam t) u\<close>,
       even though the former is a single constructor, whereas the latter contains two
       constructors.
     \<close>
 
     notation Nil  ("\<^bold>\<sharp>")
     notation Var  ("\<^bold>\<guillemotleft>_\<^bold>\<guillemotright>")
     notation Lam  ("\<^bold>\<lambda>\<^bold>[_\<^bold>]")
     notation App  (infixl "\<^bold>\<circ>" 55)
     notation Beta ("(\<^bold>\<lambda>\<^bold>[_\<^bold>] \<^bold>\<Zspot> _)" [55, 56] 55)
 
     text \<open>
       The following function computes the set of free variables of a term.
       Note that since variables are represented by numeric indices, this is a set of numbers.
     \<close>
 
     fun FV
     where "FV \<^bold>\<sharp> = {}"
         | "FV \<^bold>\<guillemotleft>i\<^bold>\<guillemotright> = {i}"
         | "FV \<^bold>\<lambda>\<^bold>[t\<^bold>] = (\<lambda>n. n - 1) ` (FV t - {0})"
         | "FV (t \<^bold>\<circ> u) = FV t \<union> FV u"
         | "FV (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) = (\<lambda>n. n - 1) ` (FV t - {0}) \<union> FV u"
 
     subsection "Some Orderings for Induction"
 
     text \<open>
       We will need to do some simultaneous inductions on pairs and triples of subterms
       of given terms.  We prove the well-foundedness of the associated relations using
       the following size measure.
     \<close>
 
     fun size :: "lambda \<Rightarrow> nat"
     where "size \<^bold>\<sharp> = 0"
         | "size \<^bold>\<guillemotleft>_\<^bold>\<guillemotright> = 1"
         | "size \<^bold>\<lambda>\<^bold>[t\<^bold>] = size t + 1"
         | "size (t \<^bold>\<circ> u) = size t + size u + 1"
         | "size (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) = (size t + 1) + size u + 1"
 
     lemma wf_if_img_lt:
     fixes r :: "('a * 'a) set" and f :: "'a \<Rightarrow> nat"
     assumes "\<And>x y. (x, y) \<in> r \<Longrightarrow> f x < f y"
     shows "wf r"
       using assms
       by (metis in_measure wf_iff_no_infinite_down_chain wf_measure)
 
     inductive subterm
     where "\<And>t. subterm t \<^bold>\<lambda>\<^bold>[t\<^bold>]"
         | "\<And>t u. subterm t (t \<^bold>\<circ> u)"
         | "\<And>t u. subterm u (t \<^bold>\<circ> u)"
         | "\<And>t u. subterm t (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u)"
         | "\<And>t u. subterm u (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u)"
         | "\<And>t u v. \<lbrakk>subterm t u; subterm u v\<rbrakk> \<Longrightarrow> subterm t v"
 
     lemma subterm_implies_smaller:
     shows "subterm t u \<Longrightarrow> size t < size u"
       by (induct rule: subterm.induct) auto
 
     abbreviation subterm_rel
     where "subterm_rel \<equiv> {(t, u). subterm t u}"
 
     lemma wf_subterm_rel:
     shows "wf subterm_rel"
       using subterm_implies_smaller wf_if_img_lt
       by (metis case_prod_conv mem_Collect_eq)
 
     abbreviation subterm_pair_rel
     where "subterm_pair_rel \<equiv> {((t1, t2), u1, u2). subterm t1 u1 \<and> subterm t2 u2}"
 
     lemma wf_subterm_pair_rel:
     shows "wf subterm_pair_rel"
       using subterm_implies_smaller
             wf_if_img_lt [of subterm_pair_rel "\<lambda>(t1, t2). max (size t1) (size t2)"]
       by fastforce
 
     abbreviation subterm_triple_rel
     where "subterm_triple_rel \<equiv>
            {((t1, t2, t3), u1, u2, u3). subterm t1 u1 \<and> subterm t2 u2 \<and> subterm t3 u3}"
 
     lemma wf_subterm_triple_rel:
     shows "wf subterm_triple_rel"
       using subterm_implies_smaller
             wf_if_img_lt [of subterm_triple_rel
                              "\<lambda>(t1, t2, t3). max (max (size t1) (size t2)) (size t3)"]
       by fastforce
 
     lemma subterm_lemmas:
     shows "subterm t \<^bold>\<lambda>\<^bold>[t\<^bold>]"
     and "subterm t (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<circ> u) \<and> subterm u (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<circ> u)"
     and "subterm t (t \<^bold>\<circ> u) \<and> subterm u (t \<^bold>\<circ> u)"
     and "subterm t (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) \<and> subterm u (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u)"
       by (metis subterm.simps)+
 
     subsection "Arrows and Identities"
 
     text \<open>
       Here we define some special classes of terms.
       An ``arrow'' is a term that contains no occurrences of \<open>Nil\<close>.
       An ``identity'' is an arrow that contains no occurrences of \<open>Beta\<close>.
       It will be important for the commutation of substitution and residuation later on
       that substitution not be used in a way that could create any marked redexes;
       for example, we don't want the substitution of \<open>Lam (Var 0)\<close> for \<open>Var 0\<close> in an
       application \<open>App (Var 0) (Var 0)\<close> to create a new ``marked'' redex.
       The use of the separate constructor \<open>Beta\<close> for marked redexes automatically avoids this.
     \<close>
 
     fun Arr
     where "Arr \<^bold>\<sharp> = False"
         | "Arr \<^bold>\<guillemotleft>_\<^bold>\<guillemotright> = True"
         | "Arr \<^bold>\<lambda>\<^bold>[t\<^bold>] = Arr t"
         | "Arr (t \<^bold>\<circ> u) = (Arr t \<and> Arr u)"
         | "Arr (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) = (Arr t \<and> Arr u)"
 
     lemma Arr_not_Nil:
     assumes "Arr t"
     shows "t \<noteq> \<^bold>\<sharp>"
       using assms by auto
 
     fun Ide
     where "Ide \<^bold>\<sharp> = False"
         | "Ide \<^bold>\<guillemotleft>_\<^bold>\<guillemotright> = True"
         | "Ide \<^bold>\<lambda>\<^bold>[t\<^bold>] = Ide t"
         | "Ide (t \<^bold>\<circ> u) = (Ide t \<and> Ide u)"
         | "Ide (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) = False"
 
     lemma Ide_implies_Arr:
     shows "Ide t \<Longrightarrow> Arr t"
       by (induct t) auto
 
     lemma ArrE [elim]:
     assumes "Arr t"
     and "\<And>i. t = \<^bold>\<guillemotleft>i\<^bold>\<guillemotright> \<Longrightarrow> T"
     and "\<And>u. t = \<^bold>\<lambda>\<^bold>[u\<^bold>] \<Longrightarrow> T"
     and "\<And>u v. t = u \<^bold>\<circ> v \<Longrightarrow> T"
     and "\<And>u v. t = \<^bold>\<lambda>\<^bold>[u\<^bold>] \<^bold>\<Zspot> v \<Longrightarrow> T"
     shows T
       using assms
       by (cases t) auto
 
     subsection "Raising Indices"
 
     text \<open>
       For substitution, we need to be able to raise the indices of all free variables
       in a subterm by a specified amount.  To do this recursively, we need to keep track
       of the depth of nesting of \<open>\<lambda>\<close>'s and only raise the indices of variables that are
       already greater than or equal to that depth, as these are the variables that are free
       in the current context.  This leads to defining a function \<open>Raise\<close> that has two arguments:
       the depth threshold \<open>d\<close> and the increment \<open>n\<close> to be added to indices above that threshold.
     \<close>
 
     fun Raise
     where "Raise _ _ \<^bold>\<sharp> = \<^bold>\<sharp>"
         | "Raise d n \<^bold>\<guillemotleft>i\<^bold>\<guillemotright> = (if i \<ge> d then \<^bold>\<guillemotleft>i+n\<^bold>\<guillemotright> else \<^bold>\<guillemotleft>i\<^bold>\<guillemotright>)"
         | "Raise d n \<^bold>\<lambda>\<^bold>[t\<^bold>] = \<^bold>\<lambda>\<^bold>[Raise (Suc d) n t\<^bold>]"
         | "Raise d n (t \<^bold>\<circ> u) = Raise d n t \<^bold>\<circ> Raise d n u"
         | "Raise d n (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) = \<^bold>\<lambda>\<^bold>[Raise (Suc d) n t\<^bold>] \<^bold>\<Zspot> Raise d n u"
 
     text \<open>
       Ultimately, the definition of substitution will only directly involve the function
       that raises all indices of variables that are free in the outermost context;
       in a term, so we introduce an abbreviation for this special case.
     \<close>
 
     abbreviation raise
     where "raise == Raise 0"
 
     lemma size_Raise:
     shows "\<And>d. size (Raise d n t) = size t"
       by (induct t) auto
 
     lemma Raise_not_Nil:
     assumes "t \<noteq> \<^bold>\<sharp>"
     shows "Raise d n t \<noteq> \<^bold>\<sharp>"
       using assms
       by (cases t) auto
 
     lemma FV_Raise:
-    shows "\<And>d n. FV (Raise d n t) = (\<lambda>x. if x \<ge> d then x + n else x) ` FV t"
-      apply (induct t)
+    shows "FV (Raise d n t) = (\<lambda>x. if x \<ge> d then x + n else x) ` FV t"
+      apply (induct t arbitrary: d n)
           apply auto[3]
             apply force
            apply force
           apply force
          apply force
         apply fastforce
     proof -
       fix t u d n
       assume ind1: "\<And>d n. FV (Raise d n t) = (\<lambda>x. if d \<le> x then x + n else x) ` FV t"
       assume ind2: "\<And>d n. FV (Raise d n u) = (\<lambda>x. if d \<le> x then x + n else x) ` FV u"
       have "FV (Raise d n (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u)) = 
             (\<lambda>x. x - Suc 0) ` ((\<lambda>x. x + n) `
               (FV t \<inter> {x. Suc d \<le> x}) \<union> FV t \<inter> {x. \<not> Suc d \<le> x} - {0}) \<union>
             ((\<lambda>x. x + n) ` (FV u \<inter> {x. d \<le> x}) \<union> FV u \<inter> {x. \<not> d \<le> x})"
         using ind1 ind2 by simp
       also have "... = (\<lambda>x. if d \<le> x then x + n else x) ` FV (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u)"
         apply simp
         by force
       finally show "FV (Raise d n (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u)) =
                     (\<lambda>x. if d \<le> x then x + n else x) ` FV (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u)"
         by blast
     qed
 
     lemma Arr_Raise:
-    shows "\<And>d n. Arr t \<longleftrightarrow> Arr (Raise d n t)"
+    shows "Arr t \<longleftrightarrow> Arr (Raise d n t)"
       using FV_Raise
-      by (induct t) auto
+      by (induct t arbitrary: d n) auto
 
     lemma Ide_Raise:
-    shows "\<And>d n. Ide t \<longleftrightarrow> Ide (Raise d n t)"
-      by (induct t) auto
+    shows "Ide t \<longleftrightarrow> Ide (Raise d n t)"
+      by (induct t arbitrary: d n) auto
 
     lemma Raise_0:
-    shows "\<And>d n. Raise d 0 t = t"
-      by (induct t) auto
+    shows "Raise d 0 t = t"
+      by (induct t arbitrary: d) auto
 
     lemma Raise_Suc:
-    shows "\<And>d n. Raise d (Suc n) t = Raise d 1 (Raise d n t)"
-      by (induct t) auto
+    shows "Raise d (Suc n) t = Raise d 1 (Raise d n t)"
+      by (induct t arbitrary: d n) auto
 
     lemma Raise_Var:
     shows "Raise d n \<^bold>\<guillemotleft>i\<^bold>\<guillemotright> = \<^bold>\<guillemotleft>if i < d then i else i + n\<^bold>\<guillemotright>"
       by auto
 
     text \<open>
       The following development of the properties of raising indices, substitution, and
       residuation has benefited greatly from the previous work by Huet \cite{huet-residual-theory}.
       In particular, it was very helpful to have correct statements of various lemmas
       available, rather than having to reconstruct them.
     \<close>
 
     lemma Raise_plus:
-    shows "\<And>d m n. Raise d (m + n) t = Raise (d + m) n (Raise d m t)"
-      by (induct t) auto
+    shows "Raise d (m + n) t = Raise (d + m) n (Raise d m t)"
+      by (induct t arbitrary: d m n) auto
 
     lemma Raise_plus':
-    shows "\<And>n m d d'. \<lbrakk>d' \<le> d + n; d \<le> d'\<rbrakk> \<Longrightarrow> Raise d (m + n) t = Raise d' m (Raise d n t)"
-      by (induct t) auto
+    shows "\<lbrakk>d' \<le> d + n; d \<le> d'\<rbrakk> \<Longrightarrow> Raise d (m + n) t = Raise d' m (Raise d n t)"
+      by (induct t arbitrary: n m d d') auto
 
     lemma Raise_Raise:
-    shows "\<And>i k n p. i \<le> n \<Longrightarrow> Raise i p (Raise n k t) = Raise (p + n) k (Raise i p t)"
-      by (induct t) auto
+    shows "i \<le> n \<Longrightarrow> Raise i p (Raise n k t) = Raise (p + n) k (Raise i p t)"
+      by (induct t arbitrary: i k n p) auto
 
     lemma raise_plus:
-    shows "\<And>n m d. d \<le> n \<Longrightarrow> raise (m + n) t = Raise d m (raise n t)"
+    shows "d \<le> n \<Longrightarrow> raise (m + n) t = Raise d m (raise n t)"
       using Raise_plus' by auto
 
     lemma raise_Raise:
-    shows "\<And>k p n. raise p (Raise n k t) = Raise (p + n) k (raise p t)"
+    shows "raise p (Raise n k t) = Raise (p + n) k (raise p t)"
       by (simp add: Raise_Raise)
 
     lemma Raise_inj:
-    shows "\<And>d n u. Raise d n t = Raise d n u \<Longrightarrow> t = u"
-    proof (induct t)
+    shows "Raise d n t = Raise d n u \<Longrightarrow> t = u"
+    proof (induct t arbitrary: d n u)
       show "\<And>d n u. Raise d n \<^bold>\<sharp> = Raise d n u \<Longrightarrow> \<^bold>\<sharp> = u"
         by (metis Raise.simps(1) Raise_not_Nil)
       show "\<And>x d n. Raise d n \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> = Raise d n u \<Longrightarrow> \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> = u" for u
         using Raise_Var
         apply (cases u, auto)
         by (metis add_lessD1 add_right_imp_eq)
       show "\<And>t d n. \<lbrakk>\<And>d n u'. Raise d n t = Raise d n u' \<Longrightarrow> t = u';
                       Raise d n \<^bold>\<lambda>\<^bold>[t\<^bold>] = Raise d n u\<rbrakk>
                         \<Longrightarrow> \<^bold>\<lambda>\<^bold>[t\<^bold>] = u"
         for u
         apply (cases u, auto)
         by (metis lambda.distinct(9))
       show "\<And>t1 t2 d n. \<lbrakk>\<And>d n u'. Raise d n t1 = Raise d n u' \<Longrightarrow> t1 = u';
                          \<And>d n u'. Raise d n t2 = Raise d n u' \<Longrightarrow> t2 = u';
                          Raise d n (t1 \<^bold>\<circ> t2) = Raise d n u\<rbrakk>
                            \<Longrightarrow> t1 \<^bold>\<circ> t2 = u"
         for u
         apply (cases u, auto)
         by (metis lambda.distinct(11))
       show "\<And>t1 t2 d n. \<lbrakk>\<And>d n u'. Raise d n t1 = Raise d n u' \<Longrightarrow> t1 = u';
                          \<And>d n u'. Raise d n t2 = Raise d n u' \<Longrightarrow> t2 = u';
                          Raise d n (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) = Raise d n u\<rbrakk>
                            \<Longrightarrow> \<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2 = u"
         for u
         apply (cases u, auto)
         by (metis lambda.distinct(13))
     qed
 
     subsection "Substitution"
 
     text \<open>
       Following \cite{huet-residual-theory}, we now define a generalized substitution operation
       with adjustment of indices.  The ultimate goal is to define the result of contraction
       of a marked redex \<open>Beta t u\<close> to be \<open>subst u t\<close>.  However, to be able to give a proper
       recursive definition of \<open>subst\<close>, we need to introduce a parameter \<open>n\<close> to keep track of the
       depth of nesting of \<open>Lam\<close>'s as we descend into the the term \<open>t\<close>.  So, instead of \<open>subst u t\<close>
       simply substituting \<open>u\<close> for occurrences of \<open>Var 0\<close>, \<open>Subst n u t\<close> will be substituting
       for occurrences of \<open>Var n\<close>, and the term \<open>u\<close> will have the indices of its free variables
       raised by \<open>n\<close> before replacing \<open>Var n\<close>.  In addition, any variables in \<open>t\<close> that have
       indices greater than \<open>n\<close> will have these indices lowered by one, to account for the
       outermost \<open>Lam\<close> that is being removed by the contraction.  We can then define
       \<open>subst u t\<close> to be \<open>Subst 0 u t\<close>.
     \<close>
 
     fun Subst
     where "Subst _ _ \<^bold>\<sharp> = \<^bold>\<sharp>"
         | "Subst n v \<^bold>\<guillemotleft>i\<^bold>\<guillemotright> = (if n < i then \<^bold>\<guillemotleft>i-1\<^bold>\<guillemotright> else if n = i then raise n v else \<^bold>\<guillemotleft>i\<^bold>\<guillemotright>)"
         | "Subst n v \<^bold>\<lambda>\<^bold>[t\<^bold>] = \<^bold>\<lambda>\<^bold>[Subst (Suc n) v t\<^bold>]"
         | "Subst n v (t \<^bold>\<circ> u) = Subst n v t \<^bold>\<circ> Subst n v u"
         | "Subst n v (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) = \<^bold>\<lambda>\<^bold>[Subst (Suc n) v t\<^bold>] \<^bold>\<Zspot> Subst n v u"
 
     abbreviation subst
     where "subst \<equiv> Subst 0"
 
     lemma Subst_Nil:
     shows "Subst n v \<^bold>\<sharp> = \<^bold>\<sharp>"
       by (cases "v = \<^bold>\<sharp>") auto
 
     lemma Subst_not_Nil:
     assumes "v \<noteq> \<^bold>\<sharp>" and "t \<noteq> \<^bold>\<sharp>"
-    shows "\<And>n. t \<noteq> \<^bold>\<sharp> \<Longrightarrow> Subst n v t \<noteq> \<^bold>\<sharp>"
+    shows "t \<noteq> \<^bold>\<sharp> \<Longrightarrow> Subst n v t \<noteq> \<^bold>\<sharp>"
       using assms Raise_not_Nil
       by (induct t) auto
 
     text \<open>
       The following expression summarizes how the set of free variables of a term \<open>Subst d u t\<close>,
       obtained by substituting \<open>u\<close> into \<open>t\<close> at depth \<open>d\<close>, relates to the sets of free variables
       of \<open>t\<close> and \<open>u\<close>.  This expression is not used in the subsequent formal development,
       but it has been left here as an aid to understanding.
     \<close>
 
     abbreviation FVS
     where "FVS d v t \<equiv> (FV t \<inter> {x. x < d}) \<union>
                         (\<lambda>x. x - 1) ` {x. x > d \<and> x \<in> FV t} \<union>
                         (\<lambda>x. x + d) ` {x. d \<in> FV t \<and> x \<in> FV v}"
 
     lemma FV_Subst:
-    shows "\<And>d v. FV (Subst d v t) = FVS d v t"
-    proof (induct t)
+    shows "FV (Subst d v t) = FVS d v t"
+    proof (induct t arbitrary: d v)
       have "\<And>d t v. (\<lambda>x. x - 1) ` (FVS (Suc d) v t - {0}) = FVS d v \<^bold>\<lambda>\<^bold>[t\<^bold>]"
         by auto force+  (* 8 sec *)
       thus "\<And>d t v. (\<And>d v. FV (Subst d v t) = FVS d v t)
                               \<Longrightarrow> FV (Subst d v \<^bold>\<lambda>\<^bold>[t\<^bold>]) = FVS d v \<^bold>\<lambda>\<^bold>[t\<^bold>]"
         by simp
       have "\<And>t u v d. (\<lambda>x. x - 1) ` (FVS (Suc d) v t - {0}) \<union> FVS d v u = FVS d v (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u)"
         by auto force+  (* 25 sec *)
       thus "\<And>t u v d. \<lbrakk>\<And>d v. FV (Subst d v t) = FVS d v t;
                        \<And>d v. FV (Subst d v u) = FVS d v u\<rbrakk>
                             \<Longrightarrow> FV (Subst d v (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u)) = FVS d v (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u)"
         by simp
     qed (auto simp add: FV_Raise)
 
     lemma Arr_Subst:
     assumes "Arr v"
-    shows "\<And>n. Arr t \<Longrightarrow> Arr (Subst n v t)"
+    shows "Arr t \<Longrightarrow> Arr (Subst n v t)"
       using assms Arr_Raise FV_Subst
-      by (induct t) auto
+      by (induct t arbitrary: n) auto
 
     lemma vacuous_Subst:
-    shows "\<And>i v. \<lbrakk>Arr v; i \<notin> FV t\<rbrakk> \<Longrightarrow> Raise i 1 (Subst i v t) = t"
-      apply (induct t, auto)
+    shows "\<lbrakk>Arr v; i \<notin> FV t\<rbrakk> \<Longrightarrow> Raise i 1 (Subst i v t) = t"
+      apply (induct t arbitrary: i v, auto)
       by force+
 
     lemma Ide_Subst_iff:
-    shows "\<And>n. Ide (Subst n v t) \<longleftrightarrow> Ide t \<and> (n \<in> FV t \<longrightarrow> Ide v)"
+    shows "Ide (Subst n v t) \<longleftrightarrow> Ide t \<and> (n \<in> FV t \<longrightarrow> Ide v)"
       using Ide_Raise vacuous_Subst
-      apply (induct t)
+      apply (induct t arbitrary: n)
           apply auto[5]
        apply fastforce
       by (metis Diff_empty Diff_insert0 One_nat_def diff_Suc_1 image_iff insertE
                 insert_Diff nat.distinct(1))
 
     lemma Ide_Subst:
-    shows "\<And>n. \<lbrakk>Ide t; Ide v\<rbrakk> \<Longrightarrow> Ide (Subst n v t)"
+    shows "\<lbrakk>Ide t; Ide v\<rbrakk> \<Longrightarrow> Ide (Subst n v t)"
       using Ide_Raise
-      by (induct t) auto
+      by (induct t arbitrary: n) auto
 
     lemma Raise_Subst:
-    shows "\<And>v k p n. Raise (p + n) k (Subst p v t) =
-                      Subst p (Raise n k v) (Raise (Suc (p + n)) k t)"
+    shows "Raise (p + n) k (Subst p v t) = Subst p (Raise n k v) (Raise (Suc (p + n)) k t)"
       using raise_Raise
-      apply (induct t, auto)
+      apply (induct t arbitrary: v k n p, auto)
       by (metis add_Suc)+
 
     lemma Raise_Subst':
     assumes "t \<noteq> \<^bold>\<sharp>"
-    shows "\<And>v n p k. \<lbrakk>v \<noteq> \<^bold>\<sharp>; k \<le> n\<rbrakk> \<Longrightarrow> Raise k p (Subst n v t) = Subst (p + n) v (Raise k p t)"
+    shows "\<lbrakk>v \<noteq> \<^bold>\<sharp>; k \<le> n\<rbrakk> \<Longrightarrow> Raise k p (Subst n v t) = Subst (p + n) v (Raise k p t)"
       using assms raise_plus
-      apply (induct t, auto)
+      apply (induct t arbitrary: v k n p, auto)
           apply (metis Raise.simps(1) Subst_Nil Suc_le_mono add_Suc_right)
          apply fastforce
         apply fastforce
        apply (metis Raise.simps(1) Subst_Nil Suc_le_mono add_Suc_right)
       by fastforce
 
     lemma Raise_subst:
-    shows "\<And>v k n. Raise n k (subst v t) = subst (Raise n k v) (Raise (Suc n) k t)"
+    shows "Raise n k (subst v t) = subst (Raise n k v) (Raise (Suc n) k t)"
       using Raise_0
-      apply (induct t, auto)
+      apply (induct t arbitrary: v k n, auto)
       by (metis One_nat_def Raise_Subst plus_1_eq_Suc)+
 
     lemma raise_Subst:
     assumes "t \<noteq> \<^bold>\<sharp>"
-    shows "\<And>v n p. v \<noteq> \<^bold>\<sharp> \<Longrightarrow> raise p (Subst n v t) = Subst (p + n) v (raise p t)"
+    shows "v \<noteq> \<^bold>\<sharp> \<Longrightarrow> raise p (Subst n v t) = Subst (p + n) v (raise p t)"
       using assms Raise_plus raise_Raise Raise_Subst'
-      apply (induct t)
+      apply (induct t arbitrary: v n p)
       by (meson zero_le)+
 
     lemma Subst_Raise:
-    shows "\<And>v m n d. \<lbrakk>v \<noteq> \<^bold>\<sharp>; d \<le> m; m \<le> n + d\<rbrakk>
-                        \<Longrightarrow> Subst m v (Raise d (Suc n) t) = Raise d n t"
-      by (induct t) auto
+    shows "\<lbrakk>v \<noteq> \<^bold>\<sharp>; d \<le> m; m \<le> n + d\<rbrakk> \<Longrightarrow> Subst m v (Raise d (Suc n) t) = Raise d n t"
+      by (induct t arbitrary: v m n d) auto
 
     lemma Subst_raise:
-    shows "\<And>v m n. \<lbrakk>v \<noteq> \<^bold>\<sharp>; m \<le> n\<rbrakk> \<Longrightarrow> Subst m v (raise (Suc n) t) = raise n t"
+    shows "\<lbrakk>v \<noteq> \<^bold>\<sharp>; m \<le> n\<rbrakk> \<Longrightarrow> Subst m v (raise (Suc n) t) = raise n t"
       using Subst_Raise
-      by (induct t) auto
+      by (induct t arbitrary: v m n) auto
 
     lemma Subst_Subst:
-    shows "\<And>v w m n. \<lbrakk>v \<noteq> \<^bold>\<sharp>; w \<noteq> \<^bold>\<sharp>\<rbrakk> \<Longrightarrow>
-                        Subst (m + n) w (Subst m v t) =
-                        Subst m (Subst n w v) (Subst (Suc (m + n)) w t)"
+    shows "\<lbrakk>v \<noteq> \<^bold>\<sharp>; w \<noteq> \<^bold>\<sharp>\<rbrakk> \<Longrightarrow>
+             Subst (m + n) w (Subst m v t) = Subst m (Subst n w v) (Subst (Suc (m + n)) w t)"
       using Raise_0 raise_Subst Subst_not_Nil Subst_raise
-      apply (induct t, auto)
+      apply (induct t arbitrary: v w m n, auto)
       by (metis add_Suc)+
 
     text \<open>
       The Substitution Lemma, as given by Huet \cite{huet-residual-theory}.
     \<close>
 
     lemma substitution_lemma:
-    shows "\<And>v w n. \<lbrakk>v \<noteq> \<^bold>\<sharp>; w \<noteq> \<^bold>\<sharp>\<rbrakk> \<Longrightarrow>
-                     Subst n v (subst w t) = subst (Subst n v w) (Subst (Suc n) v t)"
-      using Subst_not_Nil Raise_0 Subst_Subst Subst_raise
-      apply (induct t, auto)
-       apply (metis Suc_lessD Suc_pred less_imp_le zero_less_diff)
-      by (metis One_nat_def plus_1_eq_Suc)+
+    shows "\<lbrakk>v \<noteq> \<^bold>\<sharp>; w \<noteq> \<^bold>\<sharp>\<rbrakk> \<Longrightarrow> Subst n v (subst w t) = subst (Subst n v w) (Subst (Suc n) v t)"
+      by (metis Subst_Subst add_0)
 
     section "Lambda-Calculus as an RTS"
 
     subsection "Residuation"
 
     text \<open>
       We now define residuation on terms.
       Residuation is an operation which, when defined for terms \<open>t\<close> and \<open>u\<close>,
       produces terms \<open>t \ u\<close> and \<open>u \ t\<close> that represent, respectively, what remains
       of the reductions of \<open>t\<close> after performing the reductions in \<open>u\<close>,
       and what remains of the reductions of \<open>u\<close> after performing the reductions in \<open>t\<close>.
 
       The definition ensures that, if residuation is defined for two terms, then those
       terms in must be arrows that are \emph{coinitial} (\emph{i.e.}~they are the same
       after erasing marks on redexes).  The residual \<open>t \ u\<close> then has marked redexes at
       positions corresponding to redexes that were originally marked in \<open>t\<close> and that
       were not contracted by any of the reductions of \<open>u\<close>.
 
       This definition has also benefited from the presentation in \cite{huet-residual-theory}.
     \<close>
 
     fun resid  (infix "\\" 70)
     where "\<^bold>\<guillemotleft>i\<^bold>\<guillemotright> \\ \<^bold>\<guillemotleft>i'\<^bold>\<guillemotright> = (if i = i' then \<^bold>\<guillemotleft>i\<^bold>\<guillemotright> else \<^bold>\<sharp>)"
         | "\<^bold>\<lambda>\<^bold>[t\<^bold>] \\ \<^bold>\<lambda>\<^bold>[t'\<^bold>] = (if t \\ t' = \<^bold>\<sharp> then \<^bold>\<sharp> else \<^bold>\<lambda>\<^bold>[t \\ t'\<^bold>])"
         | "(t \<^bold>\<circ> u) \\ (t'\<^bold>\<circ> u') = (if t \\ t' = \<^bold>\<sharp> \<or> u \\ u' = \<^bold>\<sharp> then \<^bold>\<sharp> else (t \\ t') \<^bold>\<circ> (u \\ u'))"
         | "(\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) \\ (\<^bold>\<lambda>\<^bold>[t'\<^bold>] \<^bold>\<Zspot> u') = (if t \\ t' = \<^bold>\<sharp> \<or> u \\ u' = \<^bold>\<sharp> then \<^bold>\<sharp> else subst (u \\ u') (t \\ t'))"
         | "(\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<circ> u) \\ (\<^bold>\<lambda>\<^bold>[t'\<^bold>] \<^bold>\<Zspot> u') = (if t \\ t' = \<^bold>\<sharp> \<or> u \\ u' = \<^bold>\<sharp> then \<^bold>\<sharp> else subst (u \\ u') (t \\ t'))"
         | "(\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) \\ (\<^bold>\<lambda>\<^bold>[t'\<^bold>] \<^bold>\<circ> u') = (if t \\ t' = \<^bold>\<sharp> \<or> u \\ u' = \<^bold>\<sharp> then \<^bold>\<sharp> else \<^bold>\<lambda>\<^bold>[t \\ t'\<^bold>] \<^bold>\<Zspot> (u \\ u'))"
         | "resid _  _ = \<^bold>\<sharp>"
 
     text \<open>
       Terms t and u are \emph{consistent} if residuation is defined for them.
     \<close>
 
     abbreviation Con  (infix "\<frown>" 50)
     where "Con t u \<equiv> resid t u \<noteq> \<^bold>\<sharp>"
 
     lemma ConE [elim]:
     assumes "t \<frown> t'"
     and "\<And>i. \<lbrakk>t = \<^bold>\<guillemotleft>i\<^bold>\<guillemotright>; t' = \<^bold>\<guillemotleft>i\<^bold>\<guillemotright>; resid t t' = \<^bold>\<guillemotleft>i\<^bold>\<guillemotright>\<rbrakk> \<Longrightarrow> T"
     and "\<And>u u'. \<lbrakk>t = \<^bold>\<lambda>\<^bold>[u\<^bold>]; t' = \<^bold>\<lambda>\<^bold>[u'\<^bold>]; u \<frown> u'; t \\ t' = \<^bold>\<lambda>\<^bold>[u \\ u'\<^bold>]\<rbrakk> \<Longrightarrow> T"
     and "\<And>u v u' v'. \<lbrakk>t = u \<^bold>\<circ> v; t' = u' \<^bold>\<circ> v'; u \<frown> u'; v \<frown> v';
                       t \\ t' = (u \\ u') \<^bold>\<circ> (v \\ v')\<rbrakk> \<Longrightarrow> T"
     and "\<And>u v u' v'. \<lbrakk>t = \<^bold>\<lambda>\<^bold>[u\<^bold>] \<^bold>\<Zspot> v; t' = \<^bold>\<lambda>\<^bold>[u'\<^bold>] \<^bold>\<Zspot> v'; u \<frown> u'; v \<frown> v';
                       t \\ t' = subst (v \\ v') (u \\ u')\<rbrakk> \<Longrightarrow> T"
     and "\<And>u v u' v'. \<lbrakk>t = \<^bold>\<lambda>\<^bold>[u\<^bold>] \<^bold>\<circ> v; t' = Beta u' v'; u \<frown> u'; v \<frown> v';
                       t \\ t' = subst (v \\ v') (u \\ u')\<rbrakk> \<Longrightarrow> T"
     and "\<And>u v u' v'. \<lbrakk>t = \<^bold>\<lambda>\<^bold>[u\<^bold>] \<^bold>\<Zspot> v; t' = \<^bold>\<lambda>\<^bold>[u'\<^bold>] \<^bold>\<circ> v'; u \<frown> u'; v \<frown> v';
                       t \\ t' = \<^bold>\<lambda>\<^bold>[u \\ u'\<^bold>] \<^bold>\<Zspot> (v \\ v')\<rbrakk> \<Longrightarrow> T"
     shows T
       using assms
       apply (cases t; cases t')
                      apply simp_all
            apply metis
           apply metis
          apply metis
         apply (cases "un_App1 t", simp_all)
         apply metis
        apply (cases "un_App1 t'", simp_all)
        apply metis
       by metis
 
     text \<open>
       A term can only be consistent with another if both terms are ``arrows''.
     \<close>
 
     lemma Con_implies_Arr1:
-    shows "\<And>u. t \<frown> u \<Longrightarrow> Arr t"
-      apply (induct t)
-          apply auto[3]
-    proof -
+    shows "t \<frown> u \<Longrightarrow> Arr t"
+    proof (induct t arbitrary: u)
       fix u v t'
       assume ind1: "\<And>u'. u \<frown> u' \<Longrightarrow> Arr u"
       assume ind2: "\<And>v'. v \<frown> v' \<Longrightarrow> Arr v"
       show "u \<^bold>\<circ> v \<frown> t' \<Longrightarrow> Arr (u \<^bold>\<circ> v)"
         using ind1 ind2
         apply (cases t', simp_all)
          apply metis
         apply (cases u, simp_all)
         by (metis lambda.distinct(3) resid.simps(2))
       show "\<^bold>\<lambda>\<^bold>[u\<^bold>] \<^bold>\<Zspot> v \<frown> t' \<Longrightarrow> Arr (\<^bold>\<lambda>\<^bold>[u\<^bold>] \<^bold>\<Zspot> v)"
         using ind1 ind2
         apply (cases t', simp_all)
          apply (cases "un_App1 t'", simp_all)
         by metis+
-    qed
+    qed auto
 
     lemma Con_implies_Arr2:
-    shows "\<And>t. t \<frown> u \<Longrightarrow> Arr u"
-      apply (induct u)
-          apply auto[3]
-    proof -
+    shows "t \<frown> u \<Longrightarrow> Arr u"
+    proof (induct u arbitrary: t)
       fix u' v' t
       assume ind1: "\<And>u. u \<frown> u' \<Longrightarrow> Arr u'"
       assume ind2: "\<And>v. v \<frown> v' \<Longrightarrow> Arr v'"
       show "t \<frown> u' \<^bold>\<circ> v' \<Longrightarrow> Arr (u' \<^bold>\<circ> v')"
         using ind1 ind2
         apply (cases t, simp_all)
          apply metis
         apply (cases u', simp_all)
         by (metis lambda.distinct(3) resid.simps(2))
       show "t \<frown> (\<^bold>\<lambda>\<^bold>[u'\<^bold>] \<^bold>\<Zspot> v') \<Longrightarrow> Arr (\<^bold>\<lambda>\<^bold>[u'\<^bold>] \<^bold>\<Zspot> v')"
         using ind1 ind2
         apply (cases t, simp_all)
         apply (cases "un_App1 t", simp_all)
         by metis+
-    qed
+    qed auto
 
     lemma ConD:
     shows "t \<^bold>\<circ> u \<frown> t' \<^bold>\<circ> u' \<Longrightarrow> t \<frown> t' \<and> u \<frown> u'"
     and "\<^bold>\<lambda>\<^bold>[v\<^bold>] \<^bold>\<Zspot> u \<frown> \<^bold>\<lambda>\<^bold>[v'\<^bold>] \<^bold>\<Zspot> u' \<Longrightarrow> \<^bold>\<lambda>\<^bold>[v\<^bold>] \<frown> \<^bold>\<lambda>\<^bold>[v'\<^bold>] \<and> u \<frown> u'"
     and "\<^bold>\<lambda>\<^bold>[v\<^bold>] \<^bold>\<Zspot> u \<frown> t' \<^bold>\<circ> u' \<Longrightarrow> \<^bold>\<lambda>\<^bold>[v\<^bold>] \<frown> t' \<and> u \<frown> u'"
     and "t \<^bold>\<circ> u \<frown> \<^bold>\<lambda>\<^bold>[v'\<^bold>] \<^bold>\<Zspot> u' \<Longrightarrow> t \<frown> \<^bold>\<lambda>\<^bold>[v'\<^bold>] \<and> u \<frown> u'"
       by auto
 
     text \<open>
       Residuation on consistent terms preserves arrows.
     \<close>
 
-    lemma Arr_resid_ind:
-    shows "\<And>u. t \<frown> u \<Longrightarrow> Arr (t \\ u)"
-      apply (induct t)
-          apply auto
-    proof -
+    lemma Arr_resid:
+    shows "t \<frown> u \<Longrightarrow> Arr (t \\ u)"
+    proof (induct t arbitrary: u)
       fix t1 t2 u
       assume ind1: "\<And>u. t1 \<frown> u \<Longrightarrow> Arr (t1 \\ u)"
       assume ind2: "\<And>u. t2 \<frown> u \<Longrightarrow> Arr (t2 \\ u)"
       show "t1 \<^bold>\<circ> t2 \<frown> u \<Longrightarrow> Arr ((t1 \<^bold>\<circ> t2) \\ u)"
         using ind1 ind2 Arr_Subst
         apply (cases u, auto)
         apply (cases t1, auto)
         by (metis Arr.simps(3) ConD(2) resid.simps(2) resid.simps(4))
       show "\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2 \<frown> u \<Longrightarrow> Arr ((\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) \\ u)"
         using ind1 ind2 Arr_Subst
         by (cases u) auto
-    qed
-
-    lemma Arr_resid:
-    shows "\<And>u. t \<frown> u \<Longrightarrow> Arr (t \\ u)"
-      using Arr_resid_ind by auto
+    qed auto
 
     subsection "Source and Target"
 
     text \<open>
       Here we give syntactic versions of the \emph{source} and \emph{target} of a term.
       These will later be shown to agree (on arrows) with the versions derived from the residuation.
       The underlying idea here is that a term stands for a reduction sequence in which
       all marked redexes (corresponding to instances of the constructor \<open>Beta\<close>) are contracted
       in a bottom-up fashion.  A term without any marked redexes stands for an empty reduction
       sequence; such terms will be shown to be the identities derived from the residuation.
       The source of term is the identity obtained by erasing all markings; that is, by replacing
       all subterms of the form \<open>Beta t u\<close> by \<open>App (Lam t) u\<close>.  The target of a term is the
       identity that is the result of contracting all the marked redexes.
     \<close>
 
     fun Src
     where "Src \<^bold>\<sharp> = \<^bold>\<sharp>"
         | "Src \<^bold>\<guillemotleft>i\<^bold>\<guillemotright> = \<^bold>\<guillemotleft>i\<^bold>\<guillemotright>"
         | "Src \<^bold>\<lambda>\<^bold>[t\<^bold>] = \<^bold>\<lambda>\<^bold>[Src t\<^bold>]"
         | "Src (t \<^bold>\<circ> u) = Src t \<^bold>\<circ> Src u"
         | "Src (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) = \<^bold>\<lambda>\<^bold>[Src t\<^bold>] \<^bold>\<circ> Src u"
 
     fun Trg
     where "Trg \<^bold>\<guillemotleft>i\<^bold>\<guillemotright> = \<^bold>\<guillemotleft>i\<^bold>\<guillemotright>"
         | "Trg \<^bold>\<lambda>\<^bold>[t\<^bold>] = \<^bold>\<lambda>\<^bold>[Trg t\<^bold>]"
         | "Trg (t \<^bold>\<circ> u) = Trg t \<^bold>\<circ> Trg u"
         | "Trg (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) = subst (Trg u) (Trg t)"
         | "Trg _ = \<^bold>\<sharp>"
 
     lemma Ide_Src:
     shows "Arr t \<Longrightarrow> Ide (Src t)"
       by (induct t) auto
 
     lemma Ide_iff_Src_self:
     assumes "Arr t"
     shows "Ide t \<longleftrightarrow> Src t = t"
       using assms Ide_Src
       by (induct t) auto
 
     lemma Arr_Src [simp]:
     assumes "Arr t"
     shows "Arr (Src t)"
       using assms Ide_Src Ide_implies_Arr by blast
 
     lemma Con_Src:
-    shows "\<And>t u. \<lbrakk>size t + size u \<le> n; t \<frown> u\<rbrakk> \<Longrightarrow> Src t \<frown> Src u"
-      by (induct n) auto
+    shows "\<lbrakk>size t + size u \<le> n; t \<frown> u\<rbrakk> \<Longrightarrow> Src t \<frown> Src u"
+      by (induct n arbitrary: t u) auto
 
     lemma Src_eq_iff:
     shows "Src \<^bold>\<guillemotleft>i\<^bold>\<guillemotright> = Src \<^bold>\<guillemotleft>i'\<^bold>\<guillemotright> \<longleftrightarrow> i = i'"
     and "Src (t \<^bold>\<circ> u) = Src (t' \<^bold>\<circ> u') \<longleftrightarrow> Src t = Src t' \<and> Src u = Src u'"
     and "Src (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) = Src (\<^bold>\<lambda>\<^bold>[t'\<^bold>] \<^bold>\<Zspot> u') \<longleftrightarrow> Src t = Src t' \<and> Src u = Src u'"
     and "Src (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<circ> u) = Src (\<^bold>\<lambda>\<^bold>[t'\<^bold>] \<^bold>\<Zspot> u') \<longleftrightarrow> Src t = Src t' \<and> Src u = Src u'"
       by auto
 
     lemma Src_Raise:
-    shows "\<And>d. Src (Raise d n t) = Raise d n (Src t)"
-      by (induct t) auto
+    shows "Src (Raise d n t) = Raise d n (Src t)"
+      by (induct t arbitrary: d) auto
 
     lemma Src_Subst [simp]:
-    shows "\<And>d X. \<lbrakk>Arr t; Arr u\<rbrakk> \<Longrightarrow> Src (Subst d t u) = Subst d (Src t) (Src u)"
+    shows "\<lbrakk>Arr t; Arr u\<rbrakk> \<Longrightarrow> Src (Subst d t u) = Subst d (Src t) (Src u)"
       using Src_Raise
-      by (induct u) auto
+      by (induct u arbitrary: d X) auto
 
     lemma Ide_Trg:
     shows "Arr t \<Longrightarrow> Ide (Trg t)"
       using Ide_Subst
       by (induct t) auto
 
     lemma Ide_iff_Trg_self:
     shows "Arr t \<Longrightarrow> Ide t \<longleftrightarrow> Trg t = t"
       apply (induct t)
           apply auto
       by (metis Ide.simps(5) Ide_Subst Ide_Trg)+
 
     lemma Arr_Trg [simp]:
     assumes "Arr X"
     shows "Arr (Trg X)"
       using assms Ide_Trg Ide_implies_Arr by blast
 
     lemma Src_Src [simp]:
     assumes "Arr t"
     shows "Src (Src t) = Src t"
       using assms Ide_Src Ide_iff_Src_self Ide_implies_Arr by blast
 
     lemma Trg_Src [simp]:
     assumes "Arr t"
     shows "Trg (Src t) = Src t"
       using assms Ide_Src Ide_iff_Trg_self Ide_implies_Arr by blast
 
     lemma Trg_Trg [simp]:
     assumes "Arr t"
     shows "Trg (Trg t) = Trg t"
       using assms Ide_Trg Ide_iff_Trg_self Ide_implies_Arr by blast
 
     lemma Src_Trg [simp]:
     assumes "Arr t"
     shows "Src (Trg t) = Trg t"
       using assms Ide_Trg Ide_iff_Src_self Ide_implies_Arr by blast
 
     text \<open>
       Two terms are syntactically \emph{coinitial} if they are arrows with the same source;
       that is, they represent two reductions from the same starting term.
     \<close>
 
     abbreviation Coinitial
     where "Coinitial t u \<equiv> Arr t \<and> Arr u \<and> Src t = Src u"
 
     text \<open>
       We now show that terms are consistent if and only if they are coinitial.
     \<close>
 
     lemma Coinitial_cases:
     assumes "Arr t" and "Arr t'" and "Src t = Src t'"
     shows "(t = \<^bold>\<sharp> \<and> t' = \<^bold>\<sharp>) \<or>
            (\<exists>x. t = \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<and> t' = \<^bold>\<guillemotleft>x\<^bold>\<guillemotright>) \<or>
            (\<exists>u u'. t = \<^bold>\<lambda>\<^bold>[u\<^bold>] \<and> t' = \<^bold>\<lambda>\<^bold>[u'\<^bold>]) \<or>
            (\<exists>u v u' v'. t = u \<^bold>\<circ> v \<and> t' = u' \<^bold>\<circ> v') \<or>
            (\<exists>u v u' v'. t = \<^bold>\<lambda>\<^bold>[u\<^bold>] \<^bold>\<Zspot> v \<and> t' = \<^bold>\<lambda>\<^bold>[u'\<^bold>] \<^bold>\<Zspot> v') \<or>
            (\<exists>u v u' v'. t = \<^bold>\<lambda>\<^bold>[u\<^bold>] \<^bold>\<circ> v \<and> t' = \<^bold>\<lambda>\<^bold>[u'\<^bold>] \<^bold>\<Zspot> v') \<or>
            (\<exists>u v u' v'. t = \<^bold>\<lambda>\<^bold>[u\<^bold>] \<^bold>\<Zspot> v \<and> t' = \<^bold>\<lambda>\<^bold>[u'\<^bold>] \<^bold>\<circ> v')"
       using assms
       by (cases t; cases t') auto
 
     lemma Con_implies_Coinitial_ind:
-    shows "\<And>t u. \<lbrakk>size t + size u \<le> n; t \<frown> u\<rbrakk> \<Longrightarrow> Coinitial t u"
+    shows "\<lbrakk>size t + size u \<le> n; t \<frown> u\<rbrakk> \<Longrightarrow> Coinitial t u"
       using Con_implies_Arr1 Con_implies_Arr2
-      by (induct n) auto
+      by (induct n arbitrary: t u) auto
 
     lemma Coinitial_implies_Con_ind:
-    shows "\<And>t u. \<lbrakk>size (Src t) \<le> n; Coinitial t u\<rbrakk> \<Longrightarrow> t \<frown> u"
-    proof (induct n)
+    shows "\<lbrakk>size (Src t) \<le> n; Coinitial t u\<rbrakk> \<Longrightarrow> t \<frown> u"
+    proof (induct n arbitrary: t u)
       show "\<And>t u. \<lbrakk>size (Src t) \<le> 0; Coinitial t u\<rbrakk> \<Longrightarrow> t \<frown> u"
         by auto
       fix n t u
       assume Coinitial: "Coinitial t u"
       assume n: "size (Src t) \<le> Suc n"
       assume ind: "\<And>t u. \<lbrakk>size (Src t) \<le> n; Coinitial t u\<rbrakk> \<Longrightarrow> t \<frown> u"
       show "t \<frown> u"
         using n ind Coinitial Coinitial_cases [of t u] Subst_not_Nil by auto
     qed
 
     lemma Coinitial_iff_Con:
     shows "Coinitial t u \<longleftrightarrow> t \<frown> u"
       using Coinitial_implies_Con_ind Con_implies_Coinitial_ind by blast
 
     lemma Coinitial_Raise_Raise:
-    shows "\<And>d n u. Coinitial t u \<Longrightarrow> Coinitial (Raise d n t) (Raise d n u)"
+    shows "Coinitial t u \<Longrightarrow> Coinitial (Raise d n t) (Raise d n u)"
       using Arr_Raise Src_Raise
-      apply (induct t, auto)
+      apply (induct t arbitrary: d n u, auto)
       by (metis Raise.simps(3-4))
 
     lemma Con_sym:
     shows "t \<frown> u \<longleftrightarrow> u \<frown> t"
       by (metis Coinitial_iff_Con)
 
     lemma ConI [intro, simp]:
     assumes "Arr t" and "Arr u" and "Src t = Src u"
     shows "Con t u"
       using assms Coinitial_iff_Con by blast
 
     lemma Con_Arr_Src [simp]:
     assumes "Arr t"
     shows "t \<frown> Src t" and "Src t \<frown> t"
       using assms
       by (auto simp add: Ide_Src Ide_implies_Arr)
 
     lemma resid_Arr_self:
     shows "Arr t \<Longrightarrow> t \\ t = Trg t"
       by (induct t) auto
 
     text \<open>
       The following result is not used in the formal development that follows,
       but it requires some proof and might eventually be useful.
     \<close>
 
     lemma finite_branching:
     shows "Ide a \<Longrightarrow> finite {t. Arr t \<and> Src t = a}"
     proof (induct a)
       show "Ide \<^bold>\<sharp> \<Longrightarrow> finite {t. Arr t \<and> Src t = \<^bold>\<sharp>}"
         by simp
       fix x
       have "\<And>t. Src t = \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<longleftrightarrow> t = \<^bold>\<guillemotleft>x\<^bold>\<guillemotright>"
         using Src.elims by blast
       thus "finite {t. Arr t \<and> Src t = \<^bold>\<guillemotleft>x\<^bold>\<guillemotright>}"
         by simp
       next
       fix a
       assume a: "Ide \<^bold>\<lambda>\<^bold>[a\<^bold>]"
       assume ind: "Ide a \<Longrightarrow> finite {t. Arr t \<and> Src t = a}"
       have "{t. Arr t \<and> Src t = \<^bold>\<lambda>\<^bold>[a\<^bold>]} = Lam ` {t. Arr t \<and> Src t = a}"
-      proof
-        show "Lam ` {t. Arr t \<and> Src t = a} \<subseteq> {t. Arr t \<and> Src t = \<^bold>\<lambda>\<^bold>[a\<^bold>]}"
-          by auto
-        show "{t. Arr t \<and> Src t = \<^bold>\<lambda>\<^bold>[a\<^bold>]} \<subseteq> Lam ` {t. Arr t \<and> Src t = a}"
-        proof
-          fix t
-          assume t: "t \<in> {t. Arr t \<and> Src t = \<^bold>\<lambda>\<^bold>[a\<^bold>]}"
-          show "t \<in> Lam ` {t. Arr t \<and> Src t = a}"
-            using t by (cases t) auto
-        qed
-      qed
+        using Coinitial_cases by fastforce
       thus "finite {t. Arr t \<and> Src t = \<^bold>\<lambda>\<^bold>[a\<^bold>]}"
         using a ind by simp
       next
       fix a1 a2
       assume ind1: "Ide a1 \<Longrightarrow> finite {t. Arr t \<and> Src t = a1}"
       assume ind2: "Ide a2 \<Longrightarrow> finite {t. Arr t \<and> Src t = a2}"
       assume a: "Ide (\<^bold>\<lambda>\<^bold>[a1\<^bold>] \<^bold>\<Zspot> a2)"
       show "finite {t. Arr t \<and> Src t = \<^bold>\<lambda>\<^bold>[a1\<^bold>] \<^bold>\<Zspot> a2}"
         using a ind1 ind2 by simp
       next
       fix a1 a2
       assume ind1: "Ide a1 \<Longrightarrow> finite {t. Arr t \<and> Src t = a1}"
       assume ind2: "Ide a2 \<Longrightarrow> finite {t. Arr t \<and> Src t = a2}"
       assume a: "Ide (a1 \<^bold>\<circ> a2)"
       have "{t. Arr t \<and> Src t = a1 \<^bold>\<circ> a2} =
             ({t. is_App t} \<inter> ({t. Arr t \<and> Src (un_App1 t) = a1 \<and> Src (un_App2 t) = a2})) \<union>
             ({t. is_Beta t \<and> is_Lam a1} \<inter>
              ({t. Arr t \<and> is_Lam a1 \<and> Src (un_Beta1 t) = un_Lam a1 \<and> Src (un_Beta2 t) = a2}))"
         by fastforce
       have "{t. Arr t \<and> Src t = a1 \<^bold>\<circ> a2} =
             (\<lambda>(t1, t2). t1 \<^bold>\<circ> t2) ` ({t1. Arr t1 \<and> Src t1 = a1} \<times> {t2. Arr t2 \<and> Src t2 = a2}) \<union>
             (\<lambda>(t1, t2). \<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) `
               ({t1t2. is_Lam a1} \<inter>
                  {t1. Arr t1 \<and> Src t1 = un_Lam a1} \<times> {t2. Arr t2 \<and> Src t2 = a2})"
       proof
         show "(\<lambda>(t1, t2). t1 \<^bold>\<circ> t2) ` ({t1. Arr t1 \<and> Src t1 = a1} \<times> {t2. Arr t2 \<and> Src t2 = a2}) \<union>
               (\<lambda>(t1, t2). \<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) `
                 ({t1t2. is_Lam a1} \<inter>
                    {t1. Arr t1 \<and> Src t1 = un_Lam a1} \<times> {t2. Arr t2 \<and> Src t2 = a2})
                 \<subseteq> {t. Arr t \<and> Src t = a1 \<^bold>\<circ> a2}"
           by auto
         show "{t. Arr t \<and> Src t = a1 \<^bold>\<circ> a2}
                 \<subseteq> (\<lambda>(t1, t2). t1 \<^bold>\<circ> t2) `
                     ({t1. Arr t1 \<and> Src t1 = a1} \<times> {t2. Arr t2 \<and> Src t2 = a2}) \<union>
                   (\<lambda>(t1, t2). \<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) `
                     ({t1t2. is_Lam a1} \<inter>
                        {t1. Arr t1 \<and> Src t1 = un_Lam a1} \<times> {t2. Arr t2 \<and> Src t2 = a2})"
         proof
           fix t
           assume t: "t \<in> {t. Arr t \<and> Src t = a1 \<^bold>\<circ> a2}"
           have "is_App t \<or> is_Beta t"
             using t by auto
           moreover have "is_App t \<Longrightarrow> t \<in> (\<lambda>(t1, t2). t1 \<^bold>\<circ> t2) `
                                         ({t1. Arr t1 \<and> Src t1 = a1} \<times> {t2. Arr t2 \<and> Src t2 = a2})"
             using t image_iff is_App_def by fastforce
           moreover have "is_Beta t \<Longrightarrow>
                            t \<in> (\<lambda>(t1, t2). \<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) `
                              ({t1t2. is_Lam a1} \<inter>
                                 {t1. Arr t1 \<and> Src t1 = un_Lam a1} \<times> {t2. Arr t2 \<and> Src t2 = a2})"
             using t is_Beta_def by fastforce
           ultimately show "t \<in> (\<lambda>(t1, t2). t1 \<^bold>\<circ> t2) `
                                  ({t1. Arr t1 \<and> Src t1 = a1} \<times> {t2. Arr t2 \<and> Src t2 = a2}) \<union>
                                (\<lambda>(t1, t2). \<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) `
                                  ({t1t2. is_Lam a1} \<inter>
                                     {t1. Arr t1 \<and> Src t1 = un_Lam a1} \<times> {t2. Arr t2 \<and> Src t2 = a2})"
             by blast
         qed
       qed
       moreover have "finite ({t1. Arr t1 \<and> Src t1 = a1} \<times> {t2. Arr t2 \<and> Src t2 = a2})"
         using a ind1 ind2 Ide.simps(4) by blast
       moreover have "is_Lam a1 \<Longrightarrow>
                      finite ({t1. Arr t1 \<and> Src t1 = un_Lam a1} \<times> {t2. Arr t2 \<and> Src t2 = a2})"
       proof -
         assume a1: "is_Lam a1"
         have "Ide (un_Lam a1)"
           using a a1 is_Lam_def by force
         have "Lam ` {t1. Arr t1 \<and> Src t1 = un_Lam a1} = {t. Arr t \<and> Src t = a1}"
         proof
           show "Lam ` {t1. Arr t1 \<and> Src t1 = un_Lam a1} \<subseteq> {t. Arr t \<and> Src t = a1}"
             using a1 by fastforce
           show "{t. Arr t \<and> Src t = a1} \<subseteq> Lam ` {t1. Arr t1 \<and> Src t1 = un_Lam a1}"
           proof
             fix t
             assume t: "t \<in> {t. Arr t \<and> Src t = a1}"
             have "is_Lam t"
               using a1 t by auto
             hence "un_Lam t \<in> {t1. Arr t1 \<and> Src t1 = un_Lam a1}"
               using is_Lam_def t by force
             thus "t \<in> Lam ` {t1. Arr t1 \<and> Src t1 = un_Lam a1}"
               by (metis \<open>is_Lam t\<close> lambda.collapse(2) rev_image_eqI)
           qed
         qed
         moreover have "inj Lam"
           using inj_on_def by blast
         ultimately have "finite {t1. Arr t1 \<and> Src t1 = un_Lam a1}"
           by (metis (mono_tags, lifting) Ide.simps(4) a finite_imageD ind1 injD inj_onI)
         moreover have "finite {t2. Arr t2 \<and> Src t2 = a2}"
           using Ide.simps(4) a ind2 by blast
         ultimately
         show "finite ({t1. Arr t1 \<and> Src t1 = un_Lam a1} \<times> {t2. Arr t2 \<and> Src t2 = a2})"
           by blast
       qed
       ultimately show "finite {t. Arr t \<and> Src t = a1 \<^bold>\<circ> a2}"
         using a ind1 ind2 by simp
     qed
 
     subsection "Residuation and Substitution"
 
     text \<open>
       We now develop a series of lemmas that involve the interaction of residuation
       and substitution.
     \<close>
 
     lemma Raise_resid:
-    shows "\<And>t u k n. t \<frown> u \<Longrightarrow> Raise k n (t \\ u) = Raise k n t \\ Raise k n u"
+    shows "t \<frown> u \<Longrightarrow> Raise k n (t \\ u) = Raise k n t \\ Raise k n u"
     proof -
       (*
        * Note: This proof uses subterm induction because the hypothesis Con t u yields
        * cases in which App and Beta terms are compared, so that the first argument to App
        * needs to be unfolded.
        *)
-      fix t u k n
       let ?P = "\<lambda>(t, u). \<forall>k n. t \<frown> u \<longrightarrow> Raise k n (t \\ u) = Raise k n t \\ Raise k n u"
       have "\<And>t u.
                \<forall>t' u'. ((t', u'), (t, u)) \<in> subterm_pair_rel \<longrightarrow>
                          (\<forall>k n. t' \<frown> u' \<longrightarrow>
                                 Raise k n (t' \\ u') = Raise k n t' \\ Raise k n u') \<Longrightarrow>
                (\<And>k n. t \<frown> u \<Longrightarrow> Raise k n (t \\ u) = Raise k n t \\ Raise k n u)"
         using subterm_lemmas Coinitial_iff_Con Coinitial_Raise_Raise Raise_subst by auto
-      thus "\<And>t u k n. t \<frown> u \<Longrightarrow> Raise k n (t \\ u) = Raise k n t \\ Raise k n u"
+      thus "t \<frown> u \<Longrightarrow> Raise k n (t \\ u) = Raise k n t \\ Raise k n u"
         using wf_subterm_pair_rel wf_induct [of subterm_pair_rel ?P] by blast
     qed
 
     lemma Con_Raise:
-    shows "\<And>d n u. t \<frown> u \<Longrightarrow> Raise d n t \<frown> Raise d n u"
-      apply (induct t)
-         apply auto[3]
-      by (metis Raise_not_Nil Raise_resid)+
+    shows "t \<frown> u \<Longrightarrow> Raise d n t \<frown> Raise d n u"
+      by (metis Raise_not_Nil Raise_resid)
 
     text \<open>
       The following is Huet's Commutation Theorem \cite{huet-residual-theory}:
       ``substitution commutes with residuation''.
     \<close>
 
     lemma resid_Subst:
     assumes "t \<frown> t'" and "u \<frown> u'"
     shows "Subst n t u \\ Subst n t' u' = Subst n (t \\ t') (u \\ u')"
     proof -
       let ?P = "\<lambda>(u, u'). \<forall>n t t'. t \<frown> t' \<and> u \<frown> u' \<longrightarrow>
                                      Subst n t u \\ Subst n t' u' = Subst n (t \\ t') (u \\ u')"
       have "\<And>u u'. \<forall>w w'. ((w, w'), (u, u')) \<in> subterm_pair_rel \<longrightarrow>
                              (\<forall>n v v'. v \<frown> v' \<and> w \<frown> w' \<longrightarrow>
                                Subst n v w \\ Subst n v' w' = Subst n (v \\ v') (w \\ w')) \<Longrightarrow>
                    \<forall>n t t'. t \<frown> t' \<and> u \<frown> u' \<longrightarrow>
                               Subst n t u \\ Subst n t' u' = Subst n (t \\ t') (u \\ u')"
         using subterm_lemmas Raise_resid Subst_not_Nil Con_Raise Raise_subst substitution_lemma
         by auto
-      thus "Subst n t u \\ Subst n t' u' = Subst n (t \\ t') (u \\ u')"
+      thus ?thesis
         using assms wf_subterm_pair_rel wf_induct [of subterm_pair_rel ?P] by auto
     qed
 
     lemma Trg_Subst [simp]:
-    shows "\<And>d t. \<lbrakk>Arr t; Arr u\<rbrakk> \<Longrightarrow> Trg (Subst d t u) = Subst d (Trg t) (Trg u)"
+    shows "\<lbrakk>Arr t; Arr u\<rbrakk> \<Longrightarrow> Trg (Subst d t u) = Subst d (Trg t) (Trg u)"
       by (metis Arr_Subst Arr_Trg Arr_not_Nil resid_Arr_self resid_Subst)
 
     lemma Src_resid:
-    shows "\<And>t. t \<frown> u \<Longrightarrow> Src (t \\ u) = Trg u"
-    proof (induct u, auto simp add: Arr_resid_ind)
+    shows "t \<frown> u \<Longrightarrow> Src (t \\ u) = Trg u"
+    proof (induct u arbitrary: t, auto simp add: Arr_resid)
       fix t t1'
       show "\<And>t2'. \<lbrakk>\<And>t1. t1 \<frown> t1' \<Longrightarrow> Src (t1 \\ t1') = Trg t1';
                    \<And>t2. t2 \<frown> t2' \<Longrightarrow> Src (t2 \\ t2') = Trg t2';
                    t \<frown> t1' \<^bold>\<circ> t2'\<rbrakk>
                       \<Longrightarrow> Src (t \\ (t1' \<^bold>\<circ> t2')) = Trg t1' \<^bold>\<circ> Trg t2'"
         apply (cases t; cases t1')
                             apply auto
         by (metis Src.simps(3) lambda.distinct(3) lambda.sel(2) resid.simps(2))
     qed
 
     lemma Coinitial_resid_resid:
     assumes "t \<frown> v" and "u \<frown> v"
     shows "Coinitial (t \\ v) (u \\ v)"
       using assms Src_resid Arr_resid Coinitial_iff_Con by presburger
 
     lemma Con_implies_is_Lam_iff_is_Lam:
     assumes "t \<frown> u"
     shows "is_Lam t \<longleftrightarrow> is_Lam u"
       using assms by auto
 
     lemma Con_implies_Coinitial3:
     assumes "t \\ v \<frown> u \\ v"
     shows "Coinitial v u" and "Coinitial v t" and "Coinitial u t"
       using assms
       by (metis Coinitial_iff_Con resid.simps(7))+
 
     text \<open>
       We can now prove L\'{e}vy's ``Cube Lemma'' \cite{levy}, which is the key axiom
       for a residuated transition system.
     \<close>
 
     lemma Cube:
     shows "v \\ t \<frown> u \\ t \<Longrightarrow> (v \\ t) \\ (u \\ t) = (v \\ u) \\ (t \\ u)"
     proof -
       let ?P = "\<lambda>(t, u, v). v \\ t \<frown> u \\ t \<longrightarrow> (v \\ t) \\ (u \\ t) = (v \\ u) \\ (t \\ u)"
       have "\<And>t u v.
                \<forall>t' u' v'.
                  ((t', u', v'), (t, u, v)) \<in> subterm_triple_rel \<longrightarrow> ?P (t', u', v') \<Longrightarrow>
                    v \\ t \<frown> u \\ t \<longrightarrow> (v \\ t) \\ (u \\ t) = (v \\ u) \\ (t \\ u)"
       proof -
         fix t u v
         assume ind: "\<forall>t' u' v'. 
                        ((t', u', v'), (t, u, v)) \<in> subterm_triple_rel \<longrightarrow> ?P (t', u', v')"
         show "v \\ t \<frown> u \\ t \<longrightarrow> (v \\ t) \\ (u \\ t) = (v \\ u) \\ (t \\ u)"
         proof (intro impI)
           assume con: "v \\ t \<frown> u \\ t"
           have "Con v t"
             using con by auto
           moreover have "Con u t"
             using con by auto
           ultimately show "(v \\ t) \\ (u \\ t) = (v \\ u) \\ (t \\ u)"
             using subterm_lemmas ind Coinitial_iff_Con Coinitial_resid_resid resid_Subst
             apply (elim ConE [of v t] ConE [of u t])
                                 apply simp_all
                     apply metis
                    apply metis
                   apply (cases "un_App1 t"; cases "un_App1 v", simp_all)
                   apply metis
                  apply metis
                 apply metis
                apply metis
               apply metis
              apply (cases "un_App1 u", simp_all)
              apply metis
             by metis
         qed
       qed
       hence "?P (t, u, v)"
         using wf_subterm_triple_rel wf_induct [of subterm_triple_rel ?P] by blast
       thus "v \\ t \<frown> u \\ t \<Longrightarrow> (v \\ t) \\ (u \\ t) = (v \\ u) \\ (t \\ u)"
         by simp
     qed
 
     subsection "Residuation Determines an RTS"
 
     text \<open>
       We are now in a position to verify that the residuation operation that we have defined
       satisfies the axioms for a residuated transition system, and that various notions
       which we have defined syntactically above (\emph{e.g.}~arrow, source, target) agree
       with the versions derived abstractly from residuation.
     \<close>
 
     sublocale partial_magma resid
       apply unfold_locales
       by (metis Arr.simps(1) Coinitial_iff_Con)
 
     lemma null_char [simp]:
     shows "null = \<^bold>\<sharp>"
       using null_def
       by (metis null_is_zero(2) resid.simps(7))
 
     sublocale residuation resid
       using null_char Arr_resid Coinitial_iff_Con Cube
       apply (unfold_locales, auto)
       by metis+
 
     (* TODO: Try to understand when notation is and is not inherited. *)
     notation resid  (infix "\\" 70)
 
     lemma resid_is_residuation:
     shows "residuation resid"
       ..
 
     lemma arr_char [iff]:
     shows "arr t \<longleftrightarrow> Arr t"
       using Coinitial_iff_Con arr_def con_def null_char by auto
 
     lemma ide_char [iff]:
     shows "ide t \<longleftrightarrow> Ide t"
       by (metis Ide_iff_Trg_self Ide_implies_Arr arr_char arr_resid_iff_con ide_def
           resid_Arr_self)
 
     lemma resid_Arr_Ide:
-    shows "\<And>a. \<lbrakk>Ide a; Coinitial t a\<rbrakk> \<Longrightarrow> t \\ a = t"
+    shows "\<lbrakk>Ide a; Coinitial t a\<rbrakk> \<Longrightarrow> t \\ a = t"
       using Ide_iff_Src_self
-      by (induct t, auto)
+      by (induct t arbitrary: a, auto)
 
     lemma resid_Ide_Arr:
-    shows "\<And>t. \<lbrakk>Ide a; Coinitial a t\<rbrakk> \<Longrightarrow> Ide (a \\ t)"
-      apply (induct a)
-          apply auto[2]
-      by (metis ConI conI cube ideI ide_char null_char resid_Arr_Ide)+
+    shows "\<lbrakk>Ide a; Coinitial a t\<rbrakk> \<Longrightarrow> Ide (a \\ t)"
+      by (metis Coinitial_resid_resid ConI Ide_iff_Trg_self cube resid_Arr_Ide resid_Arr_self)
 
     lemma resid_Arr_Src [simp]:
     assumes "Arr t"
     shows "t \\ Src t = t"
       using assms Ide_Src
       by (simp add: Ide_implies_Arr resid_Arr_Ide)
 
     lemma resid_Src_Arr [simp]:
     assumes "Arr t"
     shows "Src t \\ t = Trg t"
       using assms
       by (metis (full_types) Con_Arr_Src(2) Con_implies_Arr1 Src_Src Src_resid cube
           resid_Arr_Src resid_Arr_self)
 
     sublocale rts resid
     proof
       show "\<And>a t. \<lbrakk>ide a; con t a\<rbrakk> \<Longrightarrow> t \\ a = t"
         using ide_char resid_Arr_Ide
         by (metis Coinitial_iff_Con con_def null_char)
       show "\<And>t. arr t \<Longrightarrow> ide (trg t)"
         by (simp add: Ide_Trg resid_Arr_self trg_def)
       show "\<And>a t. \<lbrakk>ide a; con a t\<rbrakk> \<Longrightarrow> ide (resid a t)"
         using ide_char null_char resid_Ide_Arr Coinitial_iff_Con con_def by force
       show "\<And>t u. con t u \<Longrightarrow> \<exists>a. ide a \<and> con a t \<and> con a u"
         by (metis Coinitial_iff_Con Ide_Src Ide_iff_Src_self Ide_implies_Arr con_def
             ide_char null_char)
       show "\<And>t u v. \<lbrakk>ide (resid t u); con u v\<rbrakk> \<Longrightarrow> con (resid t u) (resid v u)"
         by (metis Coinitial_resid_resid ide_char not_arr_null null_char resid_Ide_Arr
                   con_def con_sym ide_implies_arr)
     qed
 
     lemma is_rts:
     shows "rts resid"
       ..
 
     lemma sources_char\<^sub>\<Lambda>:
     shows "sources t = (if Arr t then {Src t} else {})"
     proof (cases "Arr t")
       show "\<not> Arr t \<Longrightarrow> ?thesis"
         using arr_char arr_iff_has_source by auto
       assume t: "Arr t"
       have 1: "{Src t} \<subseteq> sources t"
         using t Ide_Src by force
       moreover have "sources t \<subseteq> {Src t}"
         by (metis Coinitial_iff_Con Ide_iff_Src_self ide_char in_sourcesE null_char
                   con_def singleton_iff subsetI)
       ultimately show ?thesis
         using t by auto
     qed
 
     lemma sources_simp [simp]:
     assumes "Arr t"
     shows "sources t = {Src t}"
       using assms sources_char\<^sub>\<Lambda> by auto
 
     lemma sources_simps [simp]:
     shows "sources \<^bold>\<sharp> = {}"
     and "sources \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> = {\<^bold>\<guillemotleft>x\<^bold>\<guillemotright>}"
     and "arr t \<Longrightarrow> sources \<^bold>\<lambda>\<^bold>[t\<^bold>] = {\<^bold>\<lambda>\<^bold>[Src t\<^bold>]}"
     and "\<lbrakk>arr t; arr u\<rbrakk> \<Longrightarrow> sources (t \<^bold>\<circ> u) = {Src t \<^bold>\<circ> Src u}"
     and "\<lbrakk>arr t; arr u\<rbrakk> \<Longrightarrow> sources (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) = {\<^bold>\<lambda>\<^bold>[Src t\<^bold>] \<^bold>\<circ> Src u}"
       using sources_char\<^sub>\<Lambda> by auto
 
     lemma targets_char\<^sub>\<Lambda>:
     shows "targets t = (if Arr t then {Trg t} else {})"
     proof (cases "Arr t")
       show "\<not> Arr t \<Longrightarrow> ?thesis"
         by (meson arr_char arr_iff_has_target)
       assume t: "Arr t"
       have 1: "{Trg t} \<subseteq> targets t"
         using t resid_Arr_self trg_def trg_in_targets by force
       moreover have "targets t \<subseteq> {Trg t}"
         by (metis 1 Ide_iff_Src_self arr_char ide_char ide_implies_arr
             in_targetsE insert_subset prfx_implies_con resid_Arr_self
             sources_resid sources_simp t)
       ultimately show ?thesis
         using t by auto
     qed
 
     lemma targets_simp [simp]:
     assumes "Arr t"
     shows "targets t = {Trg t}"
       using assms targets_char\<^sub>\<Lambda> by auto
 
     lemma targets_simps [simp]:
     shows "targets \<^bold>\<sharp> = {}"
     and "targets \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> = {\<^bold>\<guillemotleft>x\<^bold>\<guillemotright>}"
     and "arr t \<Longrightarrow> targets \<^bold>\<lambda>\<^bold>[t\<^bold>] = {\<^bold>\<lambda>\<^bold>[Trg t\<^bold>]}"
     and "\<lbrakk>arr t; arr u\<rbrakk> \<Longrightarrow> targets (t \<^bold>\<circ> u) = {Trg t \<^bold>\<circ> Trg u}"
     and "\<lbrakk>arr t; arr u\<rbrakk> \<Longrightarrow> targets (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) = {subst (Trg u) (Trg t)}"
       using targets_char\<^sub>\<Lambda> by auto
 
     lemma seq_char:
     shows "seq t u \<longleftrightarrow> Arr t \<and> Arr u \<and> Trg t = Src u"
       using seq_def arr_char sources_char\<^sub>\<Lambda> targets_char\<^sub>\<Lambda> by force
 
     lemma seqI\<^sub>\<Lambda> [intro, simp]:
     assumes "Arr t" and "Arr u" and "Trg t = Src u"
     shows "seq t u"
       using assms seq_char by simp
 
     lemma seqE\<^sub>\<Lambda> [elim]:
     assumes "seq t u"
     and "\<lbrakk>Arr t; Arr u; Trg t = Src u\<rbrakk> \<Longrightarrow> T"
     shows T
       using assms seq_char by blast
 
     text \<open>
       The following classifies the ways that transitions can be sequential.  It is useful
       for later proofs by case analysis.
     \<close>
 
     lemma seq_cases:
     assumes "seq t u"
     shows "(is_Var t \<and> is_Var u) \<or>
            (is_Lam t \<and> is_Lam u) \<or>
            (is_App t \<and> is_App u) \<or>
            (is_App t \<and> is_Beta u \<and> is_Lam (un_App1 t)) \<or>
            (is_App t \<and> is_Beta u \<and> is_Beta (un_App1 t)) \<or>
            is_Beta t"
       using assms seq_char
       by (cases t; cases u) auto
 
     sublocale confluent_rts resid
       by (unfold_locales) fastforce
 
     lemma is_confluent_rts:
     shows "confluent_rts resid"
       ..
 
     lemma con_char [iff]:
     shows "con t u \<longleftrightarrow> Con t u"
       by fastforce
 
     lemma coinitial_char [iff]:
     shows "coinitial t u \<longleftrightarrow> Coinitial t u"
       by fastforce
 
     lemma sources_Raise:
     assumes "Arr t"
     shows "sources (Raise d n t) = {Raise d n (Src t)}"
       using assms
       by (simp add: Coinitial_Raise_Raise Src_Raise)
 
     lemma targets_Raise:
     assumes "Arr t"
     shows "targets (Raise d n t) = {Raise d n (Trg t)}"
       using assms
       by (metis Arr_Raise ConI Raise_resid resid_Arr_self targets_char\<^sub>\<Lambda>)
 
     lemma sources_subst [simp]:
     assumes "Arr t" and "Arr u"
     shows "sources (subst t u) = {subst (Src t) (Src u)}"
       using assms sources_char\<^sub>\<Lambda> Arr_Subst arr_char by simp
 
     lemma targets_subst [simp]:
     assumes "Arr t" and "Arr u"
     shows "targets (subst t u) = {subst (Trg t) (Trg u)}"
       using assms targets_char\<^sub>\<Lambda> Arr_Subst arr_char by simp
 
     notation prfx  (infix "\<lesssim>" 50)
     notation cong  (infix "\<sim>" 50)
 
     lemma prfx_char [iff]:
     shows "t \<lesssim> u \<longleftrightarrow> Ide (t \\ u)"
       using ide_char by simp
 
     lemma prfx_Var_iff:
     shows "u \<lesssim> \<^bold>\<guillemotleft>i\<^bold>\<guillemotright> \<longleftrightarrow> u = \<^bold>\<guillemotleft>i\<^bold>\<guillemotright>"
       by (metis Arr.simps(2) Coinitial_iff_Con Ide.simps(1) Ide_iff_Src_self Src.simps(2)
           ide_char resid_Arr_Ide)
 
     lemma prfx_Lam_iff:
     shows "u \<lesssim> Lam t \<longleftrightarrow> is_Lam u \<and> un_Lam u \<lesssim> t"
       using ide_char Arr_not_Nil Con_implies_is_Lam_iff_is_Lam Ide_implies_Arr is_Lam_def
       by fastforce
 
     lemma prfx_App_iff:
     shows "u \<lesssim> t1 \<^bold>\<circ> t2 \<longleftrightarrow> is_App u \<and> un_App1 u \<lesssim> t1 \<and> un_App2 u \<lesssim> t2"
       using ide_char
       by (cases u; cases t1) auto
 
     lemma prfx_Beta_iff:
     shows "u \<lesssim> \<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2 \<longleftrightarrow> 
            (is_App u \<and> un_App1 u \<lesssim> \<^bold>\<lambda>\<^bold>[t1\<^bold>] \<and> un_App2 u \<frown> t2 \<and>
              (0 \<in> FV (un_Lam (un_App1 u) \\ t1) \<longrightarrow> un_App2 u \<lesssim> t2)) \<or>
            (is_Beta u \<and> un_Beta1 u \<lesssim> t1 \<and> un_Beta2 u \<frown> t2 \<and>
              (0 \<in> FV (un_Beta1 u \\ t1) \<longrightarrow> un_Beta2 u \<lesssim> t2))"
       using ide_char Ide_Subst_iff
       by (cases u; cases "un_App1 u") auto
 
     lemma cong_Ide_are_eq:
     assumes "t \<sim> u" and "Ide t" and "Ide u"
     shows "t = u"
       using assms
       by (metis Coinitial_iff_Con Ide_iff_Src_self con_char prfx_implies_con)
 
     lemma eq_Ide_are_cong:
     assumes "t = u" and "Ide t"
     shows "t \<sim> u"
       using assms Ide_implies_Arr resid_Ide_Arr by blast
 
     sublocale weakly_extensional_rts resid
       apply unfold_locales
       by (metis Coinitial_iff_Con Ide_iff_Src_self Ide_implies_Arr ide_char ide_def)
 
     lemma is_weakly_extensional_rts:
     shows "weakly_extensional_rts resid"
       ..
 
     lemma src_char [simp]:
     shows "src t = (if Arr t then Src t else \<^bold>\<sharp>)"
       using src_def by force
 
     lemma trg_char [simp]:
     shows "trg t = (if Arr t then Trg t else \<^bold>\<sharp>)"
       by (metis Coinitial_iff_Con resid_Arr_self trg_def)
 
     text \<open>
       We ``almost'' have an extensional RTS.
       The case that fails is \<open>\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2 \<sim> u \<Longrightarrow> \<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2 = u\<close>.
       This is because \<open>t1\<close> might ignore its argument, so that \<open>subst t2 t1 = subst t2' t1\<close>,
       with both sides being identities, even if \<open>t2 \<noteq> t2'\<close>.
 
       The following gives a concrete example of such a situation.
     \<close>
 
     abbreviation non_extensional_ex1
     where "non_extensional_ex1 \<equiv> \<^bold>\<lambda>\<^bold>[\<^bold>\<lambda>\<^bold>[\<^bold>\<guillemotleft>0\<^bold>\<guillemotright>\<^bold>] \<^bold>\<circ> \<^bold>\<lambda>\<^bold>[\<^bold>\<guillemotleft>0\<^bold>\<guillemotright>\<^bold>]\<^bold>] \<^bold>\<Zspot> (\<^bold>\<lambda>\<^bold>[\<^bold>\<guillemotleft>0\<^bold>\<guillemotright>\<^bold>] \<^bold>\<Zspot> \<^bold>\<lambda>\<^bold>[\<^bold>\<guillemotleft>0\<^bold>\<guillemotright>\<^bold>])"
 
     abbreviation non_extensional_ex2
     where "non_extensional_ex2 \<equiv> \<^bold>\<lambda>\<^bold>[\<^bold>\<lambda>\<^bold>[\<^bold>\<guillemotleft>0\<^bold>\<guillemotright>\<^bold>] \<^bold>\<circ> \<^bold>\<lambda>\<^bold>[\<^bold>\<guillemotleft>0\<^bold>\<guillemotright>\<^bold>]\<^bold>] \<^bold>\<Zspot> (\<^bold>\<lambda>\<^bold>[\<^bold>\<guillemotleft>0\<^bold>\<guillemotright>\<^bold>] \<^bold>\<circ> \<^bold>\<lambda>\<^bold>[\<^bold>\<guillemotleft>0\<^bold>\<guillemotright>\<^bold>])"
 
     lemma non_extensional:
     shows "\<^bold>\<lambda>\<^bold>[\<^bold>\<guillemotleft>1\<^bold>\<guillemotright>\<^bold>] \<^bold>\<Zspot> non_extensional_ex1 \<sim> \<^bold>\<lambda>\<^bold>[\<^bold>\<guillemotleft>1\<^bold>\<guillemotright>\<^bold>] \<^bold>\<Zspot> non_extensional_ex2"
     and "\<^bold>\<lambda>\<^bold>[\<^bold>\<guillemotleft>1\<^bold>\<guillemotright>\<^bold>] \<^bold>\<Zspot>  non_extensional_ex1 \<noteq> \<^bold>\<lambda>\<^bold>[\<^bold>\<guillemotleft>1\<^bold>\<guillemotright>\<^bold>] \<^bold>\<Zspot> non_extensional_ex2"
       by auto
 
     text \<open>
       The following gives an example of two terms that are both coinitial and coterminal,
       but which are not congruent.
     \<close>
 
     abbreviation cong_nontrivial_ex1
     where "cong_nontrivial_ex1 \<equiv>
            \<^bold>\<lambda>\<^bold>[\<^bold>\<guillemotleft>0\<^bold>\<guillemotright> \<^bold>\<circ> \<^bold>\<guillemotleft>0\<^bold>\<guillemotright>\<^bold>] \<^bold>\<circ> \<^bold>\<lambda>\<^bold>[\<^bold>\<guillemotleft>0\<^bold>\<guillemotright> \<^bold>\<circ> \<^bold>\<guillemotleft>0\<^bold>\<guillemotright>\<^bold>] \<^bold>\<circ> (\<^bold>\<lambda>\<^bold>[\<^bold>\<guillemotleft>0\<^bold>\<guillemotright> \<^bold>\<circ> \<^bold>\<guillemotleft>0\<^bold>\<guillemotright>\<^bold>] \<^bold>\<Zspot> \<^bold>\<lambda>\<^bold>[\<^bold>\<guillemotleft>0\<^bold>\<guillemotright> \<^bold>\<circ> \<^bold>\<guillemotleft>0\<^bold>\<guillemotright>\<^bold>])"
 
     abbreviation cong_nontrivial_ex2
     where "cong_nontrivial_ex2 \<equiv>
            \<^bold>\<lambda>\<^bold>[\<^bold>\<guillemotleft>0\<^bold>\<guillemotright> \<^bold>\<circ> \<^bold>\<guillemotleft>0\<^bold>\<guillemotright>\<^bold>] \<^bold>\<Zspot> \<^bold>\<lambda>\<^bold>[\<^bold>\<guillemotleft>0\<^bold>\<guillemotright> \<^bold>\<circ> \<^bold>\<guillemotleft>0\<^bold>\<guillemotright>\<^bold>] \<^bold>\<circ> (\<^bold>\<lambda>\<^bold>[\<^bold>\<guillemotleft>0\<^bold>\<guillemotright> \<^bold>\<circ> \<^bold>\<guillemotleft>0\<^bold>\<guillemotright>\<^bold>] \<^bold>\<circ> \<^bold>\<lambda>\<^bold>[\<^bold>\<guillemotleft>0\<^bold>\<guillemotright> \<^bold>\<circ> \<^bold>\<guillemotleft>0\<^bold>\<guillemotright>\<^bold>])"
 
     lemma cong_nontrivial:
     shows "coinitial cong_nontrivial_ex1 cong_nontrivial_ex2"
     and "coterminal cong_nontrivial_ex1 cong_nontrivial_ex2"
     and "\<not> cong cong_nontrivial_ex1 cong_nontrivial_ex2"
       by auto
 
     text \<open>
       Every two coinitial transitions have a join, obtained structurally by unioning the sets
       of marked redexes.
     \<close>
 
     fun Join  (infix "\<squnion>" 52)
     where "\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<squnion> \<^bold>\<guillemotleft>x'\<^bold>\<guillemotright> = (if x = x' then \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> else \<^bold>\<sharp>)"
         | "\<^bold>\<lambda>\<^bold>[t\<^bold>] \<squnion> \<^bold>\<lambda>\<^bold>[t'\<^bold>] = \<^bold>\<lambda>\<^bold>[t \<squnion> t'\<^bold>]"
         | "\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<circ> u \<squnion> \<^bold>\<lambda>\<^bold>[t'\<^bold>] \<^bold>\<Zspot> u' = \<^bold>\<lambda>\<^bold>[(t \<squnion> t')\<^bold>] \<^bold>\<Zspot> (u \<squnion> u')"
         | "\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u \<squnion> \<^bold>\<lambda>\<^bold>[t'\<^bold>] \<^bold>\<circ> u' = \<^bold>\<lambda>\<^bold>[(t \<squnion> t')\<^bold>] \<^bold>\<Zspot> (u \<squnion> u')"
         | "t \<^bold>\<circ> u \<squnion> t'\<^bold>\<circ> u' = (t \<squnion> t') \<^bold>\<circ> (u \<squnion> u')"
         | "\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u \<squnion> \<^bold>\<lambda>\<^bold>[t'\<^bold>] \<^bold>\<Zspot> u' = \<^bold>\<lambda>\<^bold>[(t \<squnion> t')\<^bold>] \<^bold>\<Zspot> (u \<squnion> u')"
         | "_ \<squnion> _ = \<^bold>\<sharp>"
 
     lemma Join_sym:
     shows "t \<squnion> u = u \<squnion> t"
       using Join.induct [of "\<lambda>t u. t \<squnion> u = u \<squnion> t"] by auto
 
     lemma Src_Join:
-    shows "\<And>u. Coinitial t u \<Longrightarrow> Src (t \<squnion> u) = Src t"
-    proof (induct t)
+    shows "Coinitial t u \<Longrightarrow> Src (t \<squnion> u) = Src t"
+    proof (induct t arbitrary: u)
       show "\<And>u. Coinitial \<^bold>\<sharp> u \<Longrightarrow> Src (\<^bold>\<sharp> \<squnion> u) = Src \<^bold>\<sharp>"
         by simp
       show "\<And>x u. Coinitial \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> u \<Longrightarrow> Src (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<squnion> u) = Src \<^bold>\<guillemotleft>x\<^bold>\<guillemotright>"
         by auto
       fix t u
       assume ind: "\<And>u. Coinitial t u \<Longrightarrow> Src (t \<squnion> u) = Src t"
       assume tu: "Coinitial \<^bold>\<lambda>\<^bold>[t\<^bold>] u"
       show "Src (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<squnion> u) = Src \<^bold>\<lambda>\<^bold>[t\<^bold>]"
         using tu ind
         by (cases u) auto
       next
       fix t1 t2 u
       assume ind1: "\<And>u1. Coinitial t1 u1 \<Longrightarrow> Src (t1 \<squnion> u1) = Src t1"
       assume ind2: "\<And>u2. Coinitial t2 u2 \<Longrightarrow> Src (t2 \<squnion> u2) = Src t2"
       assume tu: "Coinitial (t1 \<^bold>\<circ> t2) u"
       show "Src (t1 \<^bold>\<circ> t2 \<squnion> u) = Src (t1 \<^bold>\<circ> t2)"
         using tu ind1 ind2
         apply (cases u, simp_all)
         apply (cases t1, simp_all)
         by (metis Arr.simps(3) Join.simps(2) Src.simps(3) lambda.sel(2))
       next
       fix t1 t2 u
       assume ind1: "\<And>u1. Coinitial t1 u1 \<Longrightarrow> Src (t1 \<squnion> u1) = Src t1"
       assume ind2: "\<And>u2. Coinitial t2 u2 \<Longrightarrow> Src (t2 \<squnion> u2) = Src t2"
       assume tu: "Coinitial (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) u"
       show "Src ((\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) \<squnion> u) = Src (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)"
         using tu ind1 ind2
         apply (cases u, simp_all)
         by (cases "un_App1 u") auto
     qed
 
     lemma resid_Join:
-    shows "\<And>u. Coinitial t u \<Longrightarrow> (t \<squnion> u) \\ u = t \\ u"
-    proof (induct t)
+    shows "Coinitial t u \<Longrightarrow> (t \<squnion> u) \\ u = t \\ u"
+    proof (induct t arbitrary: u)
       show "\<And>u. Coinitial \<^bold>\<sharp> u \<Longrightarrow> (\<^bold>\<sharp> \<squnion> u) \\ u = \<^bold>\<sharp> \\ u"
         by auto
       show "\<And>x u. Coinitial \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> u \<Longrightarrow> (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<squnion> u) \\ u = \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \\ u"
         by auto
       fix t u
       assume ind: "\<And>u. Coinitial t u \<Longrightarrow> (t \<squnion> u) \\ u = t \\ u"
       assume tu: "Coinitial \<^bold>\<lambda>\<^bold>[t\<^bold>] u"
       show "(\<^bold>\<lambda>\<^bold>[t\<^bold>] \<squnion> u) \\ u = \<^bold>\<lambda>\<^bold>[t\<^bold>] \\ u"
         using tu ind
         by (cases u) auto
       next
       fix t1 t2 u
       assume ind1: "\<And>u1. Coinitial t1 u1 \<Longrightarrow> (t1 \<squnion> u1) \\ u1 = t1 \\ u1"
       assume ind2: "\<And>u2. Coinitial t2 u2 \<Longrightarrow> (t2 \<squnion> u2) \\ u2 = t2 \\ u2"
       assume tu: "Coinitial (t1 \<^bold>\<circ> t2) u"
       show "(t1 \<^bold>\<circ> t2 \<squnion> u) \\ u = (t1 \<^bold>\<circ> t2) \\ u"
         using tu ind1 ind2 Coinitial_iff_Con
         apply (cases u, simp_all)
       proof -
         fix u1 u2
         assume u: "u = \<^bold>\<lambda>\<^bold>[u1\<^bold>] \<^bold>\<Zspot> u2"
         have t2u2: "t2 \<frown> u2"
           using Arr_not_Nil Arr_resid tu u by simp
         have t1u1: "Coinitial (un_Lam t1 \<squnion> u1) u1"
         proof -
           have "Arr (un_Lam t1 \<squnion> u1)"
             by (metis Arr.simps(3-5) Coinitial_iff_Con Con_implies_is_Lam_iff_is_Lam
                 Join.simps(2) Src.simps(3-5) ind1 lambda.collapse(2) lambda.disc(8)
                 lambda.sel(3) tu u)
           thus ?thesis
             using Src_Join
             by (metis Arr.simps(3-5) Coinitial_iff_Con Con_implies_is_Lam_iff_is_Lam
                 Src.simps(3-5) lambda.collapse(2) lambda.disc(8) lambda.sel(2-3) tu u)
         qed
         have "un_Lam t1 \<frown> u1"
           using t1u1
           by (metis Coinitial_iff_Con Con_implies_is_Lam_iff_is_Lam ConD(4) lambda.collapse(2)
               lambda.disc(8) resid.simps(2) tu u)
         thus "(t1 \<^bold>\<circ> t2 \<squnion> \<^bold>\<lambda>\<^bold>[u1\<^bold>] \<^bold>\<Zspot> u2) \\ (\<^bold>\<lambda>\<^bold>[u1\<^bold>] \<^bold>\<Zspot> u2) = (t1 \<^bold>\<circ> t2) \\ (\<^bold>\<lambda>\<^bold>[u1\<^bold>] \<^bold>\<Zspot> u2)"
           using u tu t1u1 t2u2 ind1 ind2
           apply (cases t1, auto)
         proof -
           fix v
           assume v: "t1 = \<^bold>\<lambda>\<^bold>[v\<^bold>]"
           show "subst (t2 \\ u2) ((v \<squnion> u1) \\ u1) = subst (t2 \\ u2) (v \\ u1)"
           proof -
             have "subst (t2 \\ u2) ((v \<squnion> u1) \\ u1) = (t1 \<^bold>\<circ> t2 \<squnion> \<^bold>\<lambda>\<^bold>[u1\<^bold>] \<^bold>\<Zspot> u2) \\ (\<^bold>\<lambda>\<^bold>[u1\<^bold>] \<^bold>\<Zspot> u2)"
               by (simp add: Coinitial_iff_Con ind2 t2u2 v)
             also have "... = (t1 \<^bold>\<circ> t2) \\ (\<^bold>\<lambda>\<^bold>[u1\<^bold>] \<^bold>\<Zspot> u2)"
             proof -
               have "(t1 \<^bold>\<circ> t2 \<squnion> \<^bold>\<lambda>\<^bold>[u1\<^bold>] \<^bold>\<Zspot> u2) \\ (\<^bold>\<lambda>\<^bold>[u1\<^bold>] \<^bold>\<Zspot> u2) =
                     (\<^bold>\<lambda>\<^bold>[(v \<squnion> u1)\<^bold>] \<^bold>\<Zspot> (t2 \<squnion> u2)) \\ (\<^bold>\<lambda>\<^bold>[u1\<^bold>] \<^bold>\<Zspot> u2)"
                 using v by simp
               also have "... = subst (t2 \\ u2) ((v \<squnion> u1) \\ u1)"
                 by (simp add: Coinitial_iff_Con ind2 t2u2)
               also have "... = subst (t2 \\ u2) (v \\ u1)"
               proof -
                 have "(t1 \<squnion> \<^bold>\<lambda>\<^bold>[u1\<^bold>]) \\ \<^bold>\<lambda>\<^bold>[u1\<^bold>] = t1 \\ \<^bold>\<lambda>\<^bold>[u1\<^bold>]"
                   using u tu ind1 by simp
                 thus ?thesis
                   using \<open>un_Lam t1 \ u1 \<noteq> \<^bold>\<sharp>\<close> t1u1 v by force
               qed
               also have "... = (t1 \<^bold>\<circ> t2) \\ (\<^bold>\<lambda>\<^bold>[u1\<^bold>] \<^bold>\<Zspot> u2)"
                 using tu u v by force
               finally show ?thesis by blast
             qed
             also have "... = subst (t2 \\ u2) (v \\ u1)"
               by (simp add: t2u2 v)
             finally show ?thesis by auto
           qed
         qed
       qed
       next
       fix t1 t2 u
       assume ind1: "\<And>u1. Coinitial t1 u1 \<Longrightarrow> (t1 \<squnion> u1) \\ u1 = t1 \\ u1"
       assume ind2: "\<And>u2. Coinitial t2 u2 \<Longrightarrow> (t2 \<squnion> u2) \\ u2 = t2 \\ u2"
       assume tu: "Coinitial (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) u"
       show "((\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) \<squnion> u) \\ u = (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) \\ u"
         using tu ind1 ind2 Coinitial_iff_Con
         apply (cases u, simp_all)
       proof -
         fix u1 u2
         assume u: "u = u1 \<^bold>\<circ> u2"
         show "(\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2 \<squnion> u1 \<^bold>\<circ> u2) \\ (u1 \<^bold>\<circ> u2) = (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) \\ (u1 \<^bold>\<circ> u2)"
           using ind1 ind2 tu u
           by (cases u1) auto
       qed
     qed
 
     lemma prfx_Join:
-    shows "\<And>u. Coinitial t u \<Longrightarrow> u \<lesssim> t \<squnion> u"
-    proof (induct t)
+    shows "Coinitial t u \<Longrightarrow> u \<lesssim> t \<squnion> u"
+    proof (induct t arbitrary: u)
       show "\<And>u. Coinitial \<^bold>\<sharp> u \<Longrightarrow> u \<lesssim> \<^bold>\<sharp> \<squnion> u"
         by simp
       show "\<And>x u. Coinitial \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> u \<Longrightarrow> u \<lesssim> \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<squnion> u"
         by auto
       fix t u
       assume ind: "\<And>u. Coinitial t u \<Longrightarrow> u \<lesssim> t \<squnion> u"
       assume tu: "Coinitial \<^bold>\<lambda>\<^bold>[t\<^bold>] u"
       show "u \<lesssim> \<^bold>\<lambda>\<^bold>[t\<^bold>] \<squnion> u"
         using tu ind
         apply (cases u, auto)
         by force
       next
       fix t1 t2 u
       assume ind1: "\<And>u1. Coinitial t1 u1 \<Longrightarrow> u1 \<lesssim> t1 \<squnion> u1"
       assume ind2: "\<And>u2. Coinitial t2 u2 \<Longrightarrow> u2 \<lesssim> t2 \<squnion> u2"
       assume tu: "Coinitial (t1 \<^bold>\<circ> t2) u"
       show "u \<lesssim> t1 \<^bold>\<circ> t2 \<squnion> u"
         using tu ind1 ind2 Coinitial_iff_Con
         apply (cases u, simp_all)
          apply (metis Ide.simps(1))
       proof -
         fix u1 u2
         assume u: "u = \<^bold>\<lambda>\<^bold>[u1\<^bold>] \<^bold>\<Zspot> u2"
         assume 1: "Arr t1 \<and> Arr t2 \<and> Arr u1 \<and> Arr u2 \<and> Src t1 = \<^bold>\<lambda>\<^bold>[Src u1\<^bold>] \<and> Src t2 = Src u2"
         have 2: "u1 \<frown> un_Lam t1 \<squnion> u1"
           by (metis "1" Coinitial_iff_Con Con_implies_is_Lam_iff_is_Lam Con_Arr_Src(2)
               lambda.collapse(2) lambda.disc(8) resid.simps(2) resid_Join)
         have 3: "u2 \<frown> t2 \<squnion> u2"
           by (metis "1" conE ind2 null_char prfx_implies_con)
         show "Ide ((\<^bold>\<lambda>\<^bold>[u1\<^bold>] \<^bold>\<Zspot> u2) \\ (t1 \<^bold>\<circ> t2 \<squnion> \<^bold>\<lambda>\<^bold>[u1\<^bold>] \<^bold>\<Zspot> u2))"
          using u tu 1 2 3 ind1 ind2
          apply (cases t1, simp_all)
          by (metis Arr.simps(3) Ide.simps(3) Ide_Subst Join.simps(2) Src.simps(3) resid.simps(2))
        qed
       next
       fix t1 t2 u
       assume ind1: "\<And>u1. Coinitial t1 u1 \<Longrightarrow> u1 \<lesssim> t1 \<squnion> u1"
       assume ind2: "\<And>u2. Coinitial t2 u2 \<Longrightarrow> u2 \<lesssim> t2 \<squnion> u2"
       assume tu: "Coinitial (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) u"
       show "u \<lesssim> (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) \<squnion> u"
         using tu ind1 ind2 Coinitial_iff_Con
         apply (cases u, simp_all)
          apply (cases "un_App1 u", simp_all)
         by (metis Ide.simps(1) Ide_Subst)+
     qed
 
     lemma Ide_resid_Join:
-    shows "\<And>u. Coinitial t u \<Longrightarrow> Ide (u \\ (t \<squnion> u))"
+    shows "Coinitial t u \<Longrightarrow> Ide (u \\ (t \<squnion> u))"
       using ide_char prfx_Join by blast
 
     lemma join_of_Join:
     assumes "Coinitial t u"
     shows "join_of t u (t \<squnion> u)"
     proof (unfold join_of_def composite_of_def, intro conjI)
       show "t \<lesssim> t \<squnion> u"
         using assms Join_sym prfx_Join [of u t] by simp
       show "u \<lesssim> t \<squnion> u"
         using assms Ide_resid_Join ide_char by simp
       show "(t \<squnion> u) \\ t \<lesssim> u \\ t"
         by (metis \<open>prfx u (Join t u)\<close> arr_char assms cong_subst_right(2) prfx_implies_con
             prfx_reflexive resid_Join con_sym cube)
       show "u \\ t \<lesssim> (t \<squnion> u) \\ t"
         by (metis Coinitial_resid_resid \<open>prfx t (Join t u)\<close> \<open>prfx u (Join t u)\<close> conE ide_char
             null_char prfx_implies_con resid_Ide_Arr cube)
       show "(t \<squnion> u) \\ u \<lesssim> t \\ u"
         using \<open>(t \<squnion> u) \ t \<lesssim> u \ t\<close> cube by auto
       show "t \\ u \<lesssim> (t \<squnion> u) \\ u"
         by (metis \<open>(t \<squnion> u) \ t \<lesssim> u \ t\<close> assms cube resid_Join)
     qed
 
     sublocale rts_with_joins resid
       using join_of_Join
       apply unfold_locales
       by (metis Coinitial_iff_Con conE joinable_def null_char)
 
     lemma is_rts_with_joins:
     shows "rts_with_joins resid"
       ..
 
     subsection "Simulations from Syntactic Constructors"
 
     text \<open>
       Here we show that the syntactic constructors \<open>Lam\<close> and \<open>App\<close>, as well as the substitution
       operation \<open>subst\<close>, determine simulations.  In addition, we show that \<open>Beta\<close> determines
       a transformation from \<open>App \<circ> (Lam \<times> Id)\<close> to \<open>subst\<close>.
     \<close>  
 
     abbreviation Lam\<^sub>e\<^sub>x\<^sub>t
     where "Lam\<^sub>e\<^sub>x\<^sub>t t \<equiv> if arr t then \<^bold>\<lambda>\<^bold>[t\<^bold>] else \<^bold>\<sharp>"
 
     lemma Lam_is_simulation:
     shows "simulation resid resid Lam\<^sub>e\<^sub>x\<^sub>t"
       using Arr_resid Coinitial_iff_Con
       by unfold_locales auto
 
     interpretation Lam: simulation resid resid Lam\<^sub>e\<^sub>x\<^sub>t
       using Lam_is_simulation by simp
 
     interpretation \<Lambda>x\<Lambda>: product_of_weakly_extensional_rts resid resid
       ..
 
     abbreviation App\<^sub>e\<^sub>x\<^sub>t
     where "App\<^sub>e\<^sub>x\<^sub>t t \<equiv> if \<Lambda>x\<Lambda>.arr t then fst t \<^bold>\<circ> snd t else \<^bold>\<sharp>"
 
     lemma App_is_binary_simulation:
     shows "binary_simulation resid resid resid App\<^sub>e\<^sub>x\<^sub>t"
     proof
       show "\<And>t. \<not> \<Lambda>x\<Lambda>.arr t \<Longrightarrow> App\<^sub>e\<^sub>x\<^sub>t t = null"
         by auto
       show "\<And>t u. \<Lambda>x\<Lambda>.con t u \<Longrightarrow> con (App\<^sub>e\<^sub>x\<^sub>t t) (App\<^sub>e\<^sub>x\<^sub>t u)"
         using \<Lambda>x\<Lambda>.con_char Coinitial_iff_Con by auto
       show "\<And>t u. \<Lambda>x\<Lambda>.con t u \<Longrightarrow> App\<^sub>e\<^sub>x\<^sub>t (\<Lambda>x\<Lambda>.resid t u) = App\<^sub>e\<^sub>x\<^sub>t t \\ App\<^sub>e\<^sub>x\<^sub>t u"
         using \<Lambda>x\<Lambda>.arr_char \<Lambda>x\<Lambda>.resid_def
         apply simp
-        by (metis Arr_resid_ind Con_implies_Arr1 Con_implies_Arr2)
+        by (metis Arr_resid Con_implies_Arr1 Con_implies_Arr2)
     qed
 
     interpretation App: binary_simulation resid resid resid App\<^sub>e\<^sub>x\<^sub>t
       using App_is_binary_simulation by simp
 
     abbreviation subst\<^sub>e\<^sub>x\<^sub>t
     where "subst\<^sub>e\<^sub>x\<^sub>t \<equiv> \<lambda>t. if \<Lambda>x\<Lambda>.arr t then subst (snd t) (fst t) else \<^bold>\<sharp>"
 
     lemma subst_is_binary_simulation:
     shows "binary_simulation resid resid resid subst\<^sub>e\<^sub>x\<^sub>t"
     proof
       show "\<And>t. \<not> \<Lambda>x\<Lambda>.arr t \<Longrightarrow> subst\<^sub>e\<^sub>x\<^sub>t t = null"
         by auto
       show "\<And>t u. \<Lambda>x\<Lambda>.con t u \<Longrightarrow> con (subst\<^sub>e\<^sub>x\<^sub>t t) (subst\<^sub>e\<^sub>x\<^sub>t u)"
         using \<Lambda>x\<Lambda>.con_char con_char Subst_not_Nil resid_Subst \<Lambda>x\<Lambda>.coinitialE
               \<Lambda>x\<Lambda>.con_imp_coinitial
         apply simp
         by metis
       show "\<And>t u. \<Lambda>x\<Lambda>.con t u \<Longrightarrow> subst\<^sub>e\<^sub>x\<^sub>t (\<Lambda>x\<Lambda>.resid t u) = subst\<^sub>e\<^sub>x\<^sub>t t \\ subst\<^sub>e\<^sub>x\<^sub>t u"
         using \<Lambda>x\<Lambda>.arr_char \<Lambda>x\<Lambda>.resid_def
         apply simp
-        by (metis Arr_resid_ind Con_implies_Arr1 Con_implies_Arr2 resid_Subst)
+        by (metis Arr_resid Con_implies_Arr1 Con_implies_Arr2 resid_Subst)
     qed
 
     interpretation subst: binary_simulation resid resid resid subst\<^sub>e\<^sub>x\<^sub>t
       using subst_is_binary_simulation by simp
 
     interpretation Id: identity_simulation resid
       ..
     interpretation Lam_Id: product_simulation resid resid resid resid Lam\<^sub>e\<^sub>x\<^sub>t Id.map
       ..
     interpretation App_o_Lam_Id: composite_simulation \<Lambda>x\<Lambda>.resid \<Lambda>x\<Lambda>.resid resid Lam_Id.map App\<^sub>e\<^sub>x\<^sub>t
       ..
 
     abbreviation Beta\<^sub>e\<^sub>x\<^sub>t
     where "Beta\<^sub>e\<^sub>x\<^sub>t t \<equiv> if \<Lambda>x\<Lambda>.arr t then \<^bold>\<lambda>\<^bold>[fst t\<^bold>] \<^bold>\<Zspot> snd t else \<^bold>\<sharp>"
 
     lemma Beta_is_transformation:
     shows "transformation \<Lambda>x\<Lambda>.resid resid App_o_Lam_Id.map subst\<^sub>e\<^sub>x\<^sub>t Beta\<^sub>e\<^sub>x\<^sub>t"
     proof
       show "\<And>f. \<not> \<Lambda>x\<Lambda>.arr f \<Longrightarrow> Beta\<^sub>e\<^sub>x\<^sub>t f = null"
         by simp
       show "\<And>f. \<Lambda>x\<Lambda>.ide f \<Longrightarrow> src (Beta\<^sub>e\<^sub>x\<^sub>t f) = App_o_Lam_Id.map (\<Lambda>x\<Lambda>.src f)"
         using \<Lambda>x\<Lambda>.src_char Lam_Id.map_def by simp
       show "\<And>f. \<Lambda>x\<Lambda>.ide f \<Longrightarrow> trg (Beta\<^sub>e\<^sub>x\<^sub>t f) = subst\<^sub>e\<^sub>x\<^sub>t (\<Lambda>x\<Lambda>.trg f)"
         using \<Lambda>x\<Lambda>.trg_char by simp
       show "\<And>f. \<Lambda>x\<Lambda>.arr f \<Longrightarrow>
                   Beta\<^sub>e\<^sub>x\<^sub>t (\<Lambda>x\<Lambda>.src f) \\ App_o_Lam_Id.map f = Beta\<^sub>e\<^sub>x\<^sub>t (\<Lambda>x\<Lambda>.trg f)"
           using \<Lambda>x\<Lambda>.src_char \<Lambda>x\<Lambda>.trg_char Arr_Trg Arr_not_Nil Lam_Id.map_def by simp
       show "\<And>f. \<Lambda>x\<Lambda>.arr f \<Longrightarrow> App_o_Lam_Id.map f \\ Beta\<^sub>e\<^sub>x\<^sub>t (\<Lambda>x\<Lambda>.src f) = subst\<^sub>e\<^sub>x\<^sub>t f"
           using \<Lambda>x\<Lambda>.src_char \<Lambda>x\<Lambda>.trg_char Lam_Id.map_def by auto
       show "\<And>f. \<Lambda>x\<Lambda>.arr f \<Longrightarrow> join_of (Beta\<^sub>e\<^sub>x\<^sub>t (\<Lambda>x\<Lambda>.src f)) (App_o_Lam_Id.map f) (Beta\<^sub>e\<^sub>x\<^sub>t f)"
       proof -
         fix f
         assume f: "\<Lambda>x\<Lambda>.arr f"
         show "join_of (Beta\<^sub>e\<^sub>x\<^sub>t (\<Lambda>x\<Lambda>.src f)) (App_o_Lam_Id.map f) (Beta\<^sub>e\<^sub>x\<^sub>t f)"
         proof (intro join_ofI composite_ofI)
           show "App_o_Lam_Id.map f \<lesssim> Beta\<^sub>e\<^sub>x\<^sub>t f"
             using f Lam_Id.map_def Ide_Subst arr_char prfx_char prfx_reflexive by auto
           show "Beta\<^sub>e\<^sub>x\<^sub>t f \\ Beta\<^sub>e\<^sub>x\<^sub>t (\<Lambda>x\<Lambda>.src f) \<sim> App_o_Lam_Id.map f \\ Beta\<^sub>e\<^sub>x\<^sub>t (\<Lambda>x\<Lambda>.src f)"
             using f Lam_Id.map_def \<Lambda>x\<Lambda>.src_char trg_char trg_def
             apply auto
             by (metis Arr_Subst Ide_Trg)
           show 1: "Beta\<^sub>e\<^sub>x\<^sub>t f \\ App_o_Lam_Id.map f \<sim> Beta\<^sub>e\<^sub>x\<^sub>t (\<Lambda>x\<Lambda>.src f) \\ App_o_Lam_Id.map f"
-            using f Lam_Id.map_def Ide_Subst \<Lambda>x\<Lambda>.src_char Ide_Trg Arr_resid_ind Coinitial_iff_Con
+            using f Lam_Id.map_def Ide_Subst \<Lambda>x\<Lambda>.src_char Ide_Trg Arr_resid Coinitial_iff_Con
                   resid_Arr_self
             apply simp
             by metis
           show "Beta\<^sub>e\<^sub>x\<^sub>t (\<Lambda>x\<Lambda>.src f) \<lesssim> Beta\<^sub>e\<^sub>x\<^sub>t f"
             using f 1 Lam_Id.map_def Ide_Subst \<Lambda>x\<Lambda>.src_char resid_Arr_self by auto
         qed
       qed
     qed
 
     text \<open>
       The next two results are used to show that mapping App over lists of transitions
       preserves paths.
     \<close>
 
     lemma App_is_simulation1:
     assumes "ide a"
     shows "simulation resid resid (\<lambda>t. if arr t then t \<^bold>\<circ> a else \<^bold>\<sharp>)"
     proof -
       have "(\<lambda>t. if \<Lambda>x\<Lambda>.arr (t, a) then fst (t, a) \<^bold>\<circ> snd (t, a) else \<^bold>\<sharp>) =
             (\<lambda>t. if arr t then t \<^bold>\<circ> a else \<^bold>\<sharp>)"
         using assms ide_implies_arr by force
       thus ?thesis
         using assms App.fixing_ide_gives_simulation_2 [of a] by auto
     qed
 
     lemma App_is_simulation2:
     assumes "ide a"
     shows "simulation resid resid (\<lambda>t. if arr t then a \<^bold>\<circ> t else \<^bold>\<sharp>)"
     proof -
       have "(\<lambda>t. if \<Lambda>x\<Lambda>.arr (a, t) then fst (a, t) \<^bold>\<circ> snd (a, t) else \<^bold>\<sharp>) =
             (\<lambda>t. if arr t then a \<^bold>\<circ> t else \<^bold>\<sharp>)"
         using assms ide_implies_arr by force
       thus ?thesis
         using assms App.fixing_ide_gives_simulation_1 [of a] by auto
     qed
 
     subsection "Reduction and Conversion"
 
     text \<open>
       Here we define the usual relations of reduction and conversion.
       Reduction is the least transitive relation that relates \<open>a\<close> to \<open>b\<close> if there exists
       an arrow \<open>t\<close> having \<open>a\<close> as its source and \<open>b\<close> as its target.
       Conversion is the least transitive relation that relates \<open>a\<close> to b if there exists
       an arrow \<open>t\<close> in either direction between \<open>a\<close> and \<open>b\<close>.
     \<close>
 
     inductive red
     where "Arr t \<Longrightarrow> red (Src t) (Trg t)"
         | "\<lbrakk>red a b; red b c\<rbrakk> \<Longrightarrow> red a c"
 
     inductive cnv
     where "Arr t \<Longrightarrow> cnv (Src t) (Trg t)"
         | "Arr t \<Longrightarrow> cnv (Trg t) (Src t)"
         | "\<lbrakk>cnv a b; cnv b c\<rbrakk> \<Longrightarrow> cnv a c"
 
     lemma cnv_refl:
     assumes "Ide a"
     shows "cnv a a"
       using assms
       by (metis Ide_iff_Src_self Ide_implies_Arr cnv.simps)
 
     lemma cnv_sym:
     shows "cnv a b \<Longrightarrow> cnv b a"
       apply (induct rule: cnv.induct)
       using cnv.intros(1-2)
         apply auto[2]
       using cnv.intros(3) by blast
 
     lemma red_imp_cnv:
     shows "red a b \<Longrightarrow> cnv a b"
       using cnv.intros(1,3) red.inducts by blast
 
   end
 
   text \<open>
     We now define a locale that extends the residuation operation defined above
     to paths, using general results that have already been shown for paths in an RTS.
     In particular, we are taking advantage of the general proof of the Cube Lemma for
     residuation on paths.
 
     Our immediate goal is to prove the Church-Rosser theorem, so we first prove a lemma
     that connects the reduction relation to paths.  Later, we will prove many more
     facts in this locale, thereby developing a general framework for reasoning about
     reduction paths in the \<open>\<lambda>\<close>-calculus.
   \<close>
 
   locale reduction_paths =
     \<Lambda>: lambda_calculus
   begin
 
     sublocale \<Lambda>: rts \<Lambda>.resid
       by (simp add: \<Lambda>.is_rts_with_joins rts_with_joins.axioms(1))
     sublocale paths_in_weakly_extensional_rts \<Lambda>.resid
       ..
     sublocale paths_in_confluent_rts \<Lambda>.resid
       using confluent_rts.axioms(1) \<Lambda>.is_confluent_rts paths_in_rts_def
             paths_in_confluent_rts.intro
       by blast
 
     notation \<Lambda>.resid  (infix "\\" 70)
     notation \<Lambda>.con    (infix "\<frown>" 50)
     notation \<Lambda>.prfx   (infix "\<lesssim>" 50)
     notation \<Lambda>.cong   (infix "\<sim>" 50)
 
     notation Resid    (infix "\<^sup>*\\\<^sup>*" 70)
     notation Resid1x  (infix "\<^sup>1\\\<^sup>*" 70)
     notation Residx1  (infix "\<^sup>*\\\<^sup>1" 70)
     notation con      (infix "\<^sup>*\<frown>\<^sup>*" 50)
     notation prfx     (infix "\<^sup>*\<lesssim>\<^sup>*" 50)
     notation cong     (infix "\<^sup>*\<sim>\<^sup>*" 50)
 
     lemma red_iff:
     shows "\<Lambda>.red a b \<longleftrightarrow> (\<exists>T. Arr T \<and> Src T = a \<and> Trg T = b)"
     proof
       show "\<Lambda>.red a b \<Longrightarrow> \<exists>T. Arr T \<and> Src T = a \<and> Trg T = b"
       proof (induct rule: \<Lambda>.red.induct)
         show "\<And>t. \<Lambda>.Arr t \<Longrightarrow> \<exists>T. Arr T \<and> Src T = \<Lambda>.Src t \<and> Trg T = \<Lambda>.Trg t"
           by (metis Arr.simps(2) Srcs.simps(2) Srcs_simp\<^sub>P\<^sub>W\<^sub>E Trg.simps(2) \<Lambda>.trg_def
               \<Lambda>.arr_char \<Lambda>.resid_Arr_self \<Lambda>.sources_char\<^sub>\<Lambda> singleton_insert_inj_eq')
         show "\<And>a b c. \<lbrakk>\<exists>T. Arr T \<and> Src T = a \<and> Trg T = b;
                        \<exists>T. Arr T \<and> Src T = b \<and> Trg T = c\<rbrakk>
                            \<Longrightarrow> \<exists>T. Arr T \<and> Src T = a \<and> Trg T = c"
           by (metis Arr.simps(1) Arr_appendI\<^sub>P\<^sub>W\<^sub>E Srcs_append Srcs_simp\<^sub>P\<^sub>W\<^sub>E Trgs_append
               Trgs_simp\<^sub>P\<^sub>W\<^sub>E singleton_insert_inj_eq')
       qed
       show "\<exists>T. Arr T \<and> Src T = a \<and> Trg T = b \<Longrightarrow> \<Lambda>.red a b"
       proof -
         have "Arr T \<Longrightarrow> \<Lambda>.red (Src T) (Trg T)" for T
         proof (induct T)
           show "Arr [] \<Longrightarrow> \<Lambda>.red (Src []) (Trg [])"
             by auto
           fix t T
           assume ind: "Arr T \<Longrightarrow> \<Lambda>.red (Src T) (Trg T)"
           assume Arr: "Arr (t # T)"
           show "\<Lambda>.red (Src (t # T)) (Trg (t # T))"
           proof (cases "T = []")
             show "T = [] \<Longrightarrow> ?thesis"
               using Arr arr_char \<Lambda>.red.intros(1) by simp
             assume T: "T \<noteq> []"
             have "\<Lambda>.red (Src (t # T)) (\<Lambda>.Trg t)"
               apply simp
               by (meson Arr Arr.simps(2) Con_Arr_self Con_implies_Arr(1) Con_initial_left
                   \<Lambda>.arr_char \<Lambda>.red.intros(1))
             moreover have "\<Lambda>.Trg t = Src T"
               using Arr
               by (metis Arr.elims(2) Srcs_simp\<^sub>P\<^sub>W\<^sub>E T \<Lambda>.arr_iff_has_target insert_subset
                   \<Lambda>.targets_char\<^sub>\<Lambda> list.sel(1) list.sel(3) singleton_iff)
             ultimately show ?thesis
               using ind
               by (metis (no_types, opaque_lifting) Arr Con_Arr_self Con_implies_Arr(2)
                   Resid_cons(2) T Trg.simps(3) \<Lambda>.red.intros(2) neq_Nil_conv)
           qed
         qed
         thus "\<exists>T. Arr T \<and> Src T = a \<and> Trg T = b \<Longrightarrow> \<Lambda>.red a b"
           by blast
       qed
     qed
 
   end
 
   subsection "The Church-Rosser Theorem"
 
   context lambda_calculus
   begin
 
     interpretation \<Lambda>x: reduction_paths .
 
     theorem church_rosser:
     shows "cnv a b \<Longrightarrow> \<exists>c. red a c \<and> red b c"
     proof (induct rule: cnv.induct)
       show "\<And>t. Arr t \<Longrightarrow> \<exists>c. red (Src t) c \<and> red (Trg t) c"
         by (metis Ide_Trg Ide_iff_Src_self Ide_iff_Trg_self Ide_implies_Arr red.intros(1))
       thus "\<And>t. Arr t \<Longrightarrow> \<exists>c. red (Trg t) c \<and> red (Src t) c"
         by auto
       show "\<And>a b c. \<lbrakk>cnv a b; cnv b c; \<exists>x. red a x \<and> red b x; \<exists>y. red b y \<and> red c y\<rbrakk>
                          \<Longrightarrow> \<exists>z. red a z \<and> red c z"
       proof -
         fix a b c
         assume ind1: "\<exists>x. red a x \<and> red b x" and ind2: "\<exists>y. red b y \<and> red c y"
         obtain x where x: "red a x \<and> red b x"
           using ind1 by blast
         obtain y where y: "red b y \<and> red c y"
           using ind2 by blast
         obtain T1 U1 where 1: "\<Lambda>x.Arr T1 \<and> \<Lambda>x.Arr U1 \<and> \<Lambda>x.Src T1 = a \<and> \<Lambda>x.Src U1 = b \<and>
                                \<Lambda>x.Trgs T1 = \<Lambda>x.Trgs U1"
           using x \<Lambda>x.red_iff [of a x] \<Lambda>x.red_iff [of b x] by fastforce
         obtain T2 U2 where 2: "\<Lambda>x.Arr T2 \<and> \<Lambda>x.Arr U2 \<and> \<Lambda>x.Src T2 = b \<and> \<Lambda>x.Src U2 = c \<and>
                                \<Lambda>x.Trgs T2 = \<Lambda>x.Trgs U2"
           using y \<Lambda>x.red_iff [of b y] \<Lambda>x.red_iff [of c y] by fastforce
         show "\<exists>e. red a e \<and> red c e"
         proof -
           let ?T = "T1 @ (\<Lambda>x.Resid T2 U1)" and ?U = "U2 @ (\<Lambda>x.Resid U1 T2)"
           have 3: "\<Lambda>x.Arr ?T \<and> \<Lambda>x.Arr ?U \<and> \<Lambda>x.Src ?T = a \<and> \<Lambda>x.Src ?U = c"
             using 1 2
             by (metis \<Lambda>x.Arr_appendI\<^sub>P\<^sub>W\<^sub>E \<Lambda>x.Arr_has_Trg \<Lambda>x.Con_imp_Arr_Resid \<Lambda>x.Src_append
                 \<Lambda>x.Src_resid \<Lambda>x.Srcs_simp\<^sub>P\<^sub>W\<^sub>E \<Lambda>x.Trgs.simps(1) \<Lambda>x.Trgs_simp\<^sub>P\<^sub>W\<^sub>E \<Lambda>x.arrI\<^sub>P
                 \<Lambda>x.arr_append_imp_seq \<Lambda>x.confluence_ind singleton_insert_inj_eq')
           moreover have "\<Lambda>x.Trgs ?T = \<Lambda>x.Trgs ?U"
             using 1 2 3 \<Lambda>x.Srcs_simp\<^sub>P\<^sub>W\<^sub>E \<Lambda>x.Trgs_Resid_sym \<Lambda>x.Trgs_append \<Lambda>x.confluence_ind
             by presburger
           ultimately have "\<exists>T U. \<Lambda>x.Arr T \<and> \<Lambda>x.Arr U \<and> \<Lambda>x.Src T = a \<and> \<Lambda>x.Src U = c \<and>
                                  \<Lambda>x.Trgs T = \<Lambda>x.Trgs U"
             by blast
           thus ?thesis
             using \<Lambda>x.red_iff \<Lambda>x.Arr_has_Trg by fastforce
         qed
       qed
     qed
 
     corollary weak_diamond:
     assumes "red a b" and "red a b'"
     obtains c where "red b c" and "red b' c"
     proof -
       have "cnv b b'"
         using assms
-        by (metis cnv.intros(1) cnv.intros(3) cnv_sym red.induct)
+        by (metis cnv.intros(1,3) cnv_sym red.induct)
       thus ?thesis
         using that church_rosser by blast
     qed
 
     text \<open>
       As a consequence of the Church-Rosser Theorem, the collection of all reduction
       paths forms a coherent normal sub-RTS of the RTS of reduction paths, and on identities
       the congruence induced by this normal sub-RTS coincides with convertibility.
       The quotient of the \<open>\<lambda>\<close>-calculus RTS by this congruence is then obviously discrete:
       the only transitions are identities.
     \<close>
 
     interpretation Red: normal_sub_rts \<Lambda>x.Resid \<open>Collect \<Lambda>x.Arr\<close>
     proof
       show "\<And>t. t \<in> Collect \<Lambda>x.Arr \<Longrightarrow> \<Lambda>x.arr t"
         by blast
       show "\<And>a. \<Lambda>x.ide a \<Longrightarrow> a \<in> Collect \<Lambda>x.Arr"
         using \<Lambda>x.Ide_char \<Lambda>x.ide_char by blast
       show "\<And>u t. \<lbrakk>u \<in> Collect \<Lambda>x.Arr; \<Lambda>x.coinitial t u\<rbrakk> \<Longrightarrow> \<Lambda>x.Resid u t \<in> Collect \<Lambda>x.Arr"
         by (metis \<Lambda>x.Con_imp_Arr_Resid \<Lambda>x.Resid.simps(1) \<Lambda>x.con_sym \<Lambda>x.confluence\<^sub>P \<Lambda>x.ide_def
             \<open>\<And>a. \<Lambda>x.ide a \<Longrightarrow> a \<in> Collect \<Lambda>x.Arr\<close> mem_Collect_eq \<Lambda>x.arr_resid_iff_con)
       show "\<And>u t. \<lbrakk>u \<in> Collect \<Lambda>x.Arr; \<Lambda>x.Resid t u \<in> Collect \<Lambda>x.Arr\<rbrakk> \<Longrightarrow> t \<in> Collect \<Lambda>x.Arr"
         by (metis \<Lambda>x.Arr.simps(1) \<Lambda>x.Con_implies_Arr(1) mem_Collect_eq)
       show "\<And>u t. \<lbrakk>u \<in> Collect \<Lambda>x.Arr; \<Lambda>x.seq u t\<rbrakk> \<Longrightarrow> \<exists>v. \<Lambda>x.composite_of u t v"
         by (meson \<Lambda>x.obtains_composite_of)
       show "\<And>u t. \<lbrakk>u \<in> Collect \<Lambda>x.Arr; \<Lambda>x.seq t u\<rbrakk> \<Longrightarrow> \<exists>v. \<Lambda>x.composite_of t u v"
         by (meson \<Lambda>x.obtains_composite_of)
     qed
 
     interpretation Red: coherent_normal_sub_rts \<Lambda>x.Resid \<open>Collect \<Lambda>x.Arr\<close>
       apply unfold_locales
       by (metis Red.Cong_closure_props(4) Red.Cong_imp_arr(2) \<Lambda>x.Con_imp_Arr_Resid
           \<Lambda>x.arr_resid_iff_con \<Lambda>x.con_char \<Lambda>x.sources_resid mem_Collect_eq)
 
     lemma cnv_iff_Cong:
     assumes "ide a" and "ide b"
     shows "cnv a b \<longleftrightarrow> Red.Cong [a] [b]"
     proof
       assume 1: "Red.Cong [a] [b]"
       obtain U V
         where UV: "\<Lambda>x.Arr U \<and> \<Lambda>x.Arr V \<and> Red.Cong\<^sub>0 (\<Lambda>x.Resid [a] U) (\<Lambda>x.Resid [b] V)"
         using 1 Red.Cong_def [of "[a]" "[b]"] by blast
       have "red a (\<Lambda>x.Trg U) \<and> red b (\<Lambda>x.Trg V)"
         by (metis UV \<Lambda>x.Arr.simps(1) \<Lambda>x.Con_implies_Arr(1) \<Lambda>x.Resid_single_ide(2) \<Lambda>x.Src_resid
             \<Lambda>x.Trg.simps(2) assms(1-2) mem_Collect_eq reduction_paths.red_iff trg_ide)
       moreover have "\<Lambda>x.Trg U = \<Lambda>x.Trg V"
         using UV
         by (metis (no_types, lifting) Red.Cong\<^sub>0_imp_con \<Lambda>x.Arr.simps(1) \<Lambda>x.Con_Arr_self
             \<Lambda>x.Con_implies_Arr(1) \<Lambda>x.Resid_single_ide(2) \<Lambda>x.Src_resid \<Lambda>x.cube \<Lambda>x.ide_def
             \<Lambda>x.resid_arr_ide assms(1) mem_Collect_eq)
       ultimately show "cnv a b"
         by (metis cnv_sym cnv.intros(3) red_imp_cnv)
       next
       assume 1: "cnv a b"
       obtain c where c: "red a c \<and> red b c"
         using 1 church_rosser by blast
       obtain U where U: "\<Lambda>x.Arr U \<and> \<Lambda>x.Src U = a \<and> \<Lambda>x.Trg U = c"
         using c \<Lambda>x.red_iff by blast
       obtain V where V: "\<Lambda>x.Arr V \<and> \<Lambda>x.Src V = b \<and> \<Lambda>x.Trg V = c"
         using c \<Lambda>x.red_iff by blast
       have "\<Lambda>x.Resid1x a U = c \<and> \<Lambda>x.Resid1x b V = c"
         by (metis U V \<Lambda>x.Con_single_ide_ind \<Lambda>x.Ide.simps(2) \<Lambda>x.Resid1x_as_Resid
             \<Lambda>x.Resid_Ide_Arr_ind \<Lambda>x.Resid_single_ide(2) \<Lambda>x.Srcs_simp\<^sub>P\<^sub>W\<^sub>E \<Lambda>x.Trg.simps(2)
             \<Lambda>x.Trg_resid_sym \<Lambda>x.ex_un_Src assms(1-2) singletonD trg_ide)
       hence "Red.Cong\<^sub>0 (\<Lambda>x.Resid [a] U) (\<Lambda>x.Resid [b] V)"
         by (metis Red.Cong\<^sub>0_reflexive U V \<Lambda>x.Con_single_ideI(1) \<Lambda>x.Resid1x_as_Resid
             \<Lambda>x.Srcs_simp\<^sub>P\<^sub>W\<^sub>E \<Lambda>x.arr_resid \<Lambda>x.con_char assms(1-2) empty_set
             list.set_intros(1) list.simps(15))
       thus "Red.Cong [a] [b]"
         using U V Red.Cong_def [of "[a]" "[b]"] by blast
     qed
 
     interpretation \<Lambda>q: quotient_by_coherent_normal \<Lambda>x.Resid \<open>Collect \<Lambda>x.Arr\<close>
       ..
 
     lemma quotient_by_cnv_is_discrete:
     shows "\<Lambda>q.arr t \<longleftrightarrow> \<Lambda>q.ide t"
       by (metis Red.Cong_class_memb_is_arr \<Lambda>q.arr_char \<Lambda>q.ide_char' \<Lambda>x.arr_char
           mem_Collect_eq subsetI)
 
     subsection "Normalization"
 
     text \<open>
       A \emph{normal form} is an identity that is not the source of any non-identity arrow.
     \<close>
 
     definition NF
     where "NF a \<equiv> Ide a \<and> (\<forall>t. Arr t \<and> Src t = a \<longrightarrow> Ide t)"
 
     lemma (in reduction_paths) path_from_NF_is_Ide:
     assumes "\<Lambda>.NF a"
     shows "\<lbrakk>Arr U; Src U = a\<rbrakk> \<Longrightarrow> Ide U"
     proof (induct U, simp)
       fix u U
       assume ind: "\<lbrakk>Arr U; Src U = a\<rbrakk> \<Longrightarrow> Ide U"
       assume uU: "Arr (u # U)" and a: "Src (u # U) = a"
       have "\<Lambda>.Ide u"
         using assms a \<Lambda>.NF_def uU by force
       thus "Ide (u # U)"
-        using uU ind
-        apply (cases "U = []")
-         apply simp
-        by (metis Arr_consE Con_Arr_self Con_initial_right Ide.simps(2) Ide_consI
-            Resid_Arr_Ide_ind Src_resid Trg.simps(2) a \<Lambda>.ide_char)
+        using a uU ind
+        by (metis Arr_consE Con_Arr_self Con_imp_eq_Srcs Con_initial_right Ide.simps(2)
+                  Ide_consI Srcs.simps(2) Srcs_simp\<^sub>P\<^sub>W\<^sub>E \<Lambda>.Ide_iff_Src_self \<Lambda>.Ide_implies_Arr
+                  \<Lambda>.sources_char\<^sub>\<Lambda> \<Lambda>.trg_ide \<Lambda>.ide_char
+                  singleton_insert_inj_eq)
     qed
 
     lemma NF_reduct_is_trivial:
     assumes "NF a" and "red a b"
     shows "a = b"
     proof -
       interpret \<Lambda>x: reduction_paths .
       have "\<And>U. \<lbrakk>\<Lambda>x.Arr U; a \<in> \<Lambda>x.Srcs U\<rbrakk> \<Longrightarrow> \<Lambda>x.Ide U"
         using assms \<Lambda>x.path_from_NF_is_Ide
         by (simp add: \<Lambda>x.Srcs_simp\<^sub>P\<^sub>W\<^sub>E)
       thus ?thesis
         using assms \<Lambda>x.red_iff
         by (metis \<Lambda>x.Con_Arr_self \<Lambda>x.Resid_Arr_Ide_ind \<Lambda>x.Src_resid \<Lambda>x.path_from_NF_is_Ide)
     qed
 
     lemma NF_unique:
     assumes "red t u" and "red t u'" and "NF u" and "NF u'"
     shows "u = u'"
       using assms weak_diamond NF_reduct_is_trivial by metis
 
     text \<open>
       A term is \emph{normalizable} if it is an identity that is reducible to a normal form.
     \<close>
 
     definition normalizable
     where "normalizable a \<equiv> Ide a \<and> (\<exists>b. red a b \<and> NF b)"
 
   end
 
   section "Reduction Paths"
 
   text \<open>
     In this section we develop further facts about reduction paths for the \<open>\<lambda>\<close>-calculus.
   \<close>
 
   context reduction_paths
   begin
 
     subsection "Sources and Targets"
 
     lemma Srcs_simp\<^sub>\<Lambda>\<^sub>P:
     shows "Arr t \<Longrightarrow> Srcs t = {\<Lambda>.Src (hd t)}"
       by (metis Arr_has_Src Srcs.elims list.sel(1) \<Lambda>.sources_char\<^sub>\<Lambda>)
 
     lemma Trgs_simp\<^sub>\<Lambda>\<^sub>P:
     shows "Arr t \<Longrightarrow> Trgs t = {\<Lambda>.Trg (last t)}"
       by (metis Arr.simps(1) Arr_has_Trg Trgs.simps(2) Trgs_append
           append_butlast_last_id not_Cons_self2 \<Lambda>.targets_char\<^sub>\<Lambda>)
 
     lemma sources_single_Src [simp]:
     assumes "\<Lambda>.Arr t"
     shows "sources [\<Lambda>.Src t] = sources [t]"
       using assms
       by (metis \<Lambda>.Con_Arr_Src(1) \<Lambda>.Ide_Src Ide.simps(2) Resid.simps(3) con_char ideE
           ide_char sources_resid \<Lambda>.con_char \<Lambda>.ide_char list.discI \<Lambda>.resid_Arr_Src)
 
     lemma targets_single_Trg [simp]:
     assumes "\<Lambda>.Arr t"
     shows "targets [\<Lambda>.Trg t] = targets [t]"
       using assms
       by (metis (full_types) Resid.simps(3) conI\<^sub>P \<Lambda>.Arr_Trg \<Lambda>.arr_char \<Lambda>.resid_Arr_Src
           \<Lambda>.resid_Src_Arr \<Lambda>.arr_resid_iff_con targets_resid_sym)
 
     lemma sources_single_Trg [simp]:
     assumes "\<Lambda>.Arr t"
     shows "sources [\<Lambda>.Trg t] = targets [t]"
       using assms
       by (metis \<Lambda>.Ide_Trg Ide.simps(2) ideE ide_char sources_resid \<Lambda>.ide_char
           targets_single_Trg)
 
     lemma targets_single_Src [simp]:
     assumes "\<Lambda>.Arr t"
     shows "targets [\<Lambda>.Src t] = sources [t]"
       using assms
       by (metis \<Lambda>.Arr_Src \<Lambda>.Trg_Src sources_single_Src sources_single_Trg)
 
     lemma single_Src_hd_in_sources:
     assumes "Arr T"
     shows "[\<Lambda>.Src (hd T)] \<in> sources T"
       using assms
       by (metis Arr.simps(1) Arr_has_Src Ide.simps(2) Resid_Arr_Src Srcs_simp\<^sub>P
           \<Lambda>.source_is_ide conI\<^sub>P empty_set ide_char in_sourcesI \<Lambda>.sources_char\<^sub>\<Lambda>
           list.set_intros(1) list.simps(15))
 
     lemma single_Trg_last_in_targets:
     assumes "Arr T"
     shows "[\<Lambda>.Trg (last T)] \<in> targets T"
       using assms targets_char\<^sub>P Arr_imp_arr_last Trgs_simp\<^sub>\<Lambda>\<^sub>P \<Lambda>.Ide_Trg by fastforce
 
     lemma in_sources_iff:
     assumes "Arr T"
     shows "A \<in> sources T \<longleftrightarrow> A \<^sup>*\<sim>\<^sup>* [\<Lambda>.Src (hd T)]"
       using assms
       by (meson single_Src_hd_in_sources sources_are_cong sources_cong_closed)
 
     lemma in_targets_iff:
     assumes "Arr T"
     shows "B \<in> targets T \<longleftrightarrow> B \<^sup>*\<sim>\<^sup>* [\<Lambda>.Trg (last T)]"
       using assms
       by (meson single_Trg_last_in_targets targets_are_cong targets_cong_closed)
 
     lemma seq_imp_cong_Trg_last_Src_hd:
     assumes "seq T U"
     shows "\<Lambda>.Trg (last T) \<sim> \<Lambda>.Src (hd U)"
       using assms Arr_imp_arr_hd Arr_imp_arr_last Srcs_simp\<^sub>P\<^sub>W\<^sub>E Trgs_simp\<^sub>P\<^sub>W\<^sub>E
             \<Lambda>.cong_reflexive seq_char
       by (metis Srcs_simp\<^sub>\<Lambda>\<^sub>P Trgs_simp\<^sub>\<Lambda>\<^sub>P \<Lambda>.Arr_Trg \<Lambda>.arr_char singleton_inject)
 
     lemma sources_char\<^sub>\<Lambda>\<^sub>P:
     shows "sources T = {A. Arr T \<and> A \<^sup>*\<sim>\<^sup>* [\<Lambda>.Src (hd T)]}"
       using in_sources_iff arr_char sources_char\<^sub>P by auto
 
     lemma targets_char\<^sub>\<Lambda>\<^sub>P:
     shows "targets T = {B. Arr T \<and> B \<^sup>*\<sim>\<^sup>* [\<Lambda>.Trg (last T)]}"
       using in_targets_iff arr_char targets_char by auto
 
     lemma Src_hd_eqI:
     assumes "cong T U"
     shows "\<Lambda>.Src (hd T) = \<Lambda>.Src (hd U)"
       using assms
       by (metis Con_imp_eq_Srcs Con_implies_Arr(1) Ide.simps(1) Srcs_simp\<^sub>\<Lambda>\<^sub>P ide_char
           singleton_insert_inj_eq')
 
     lemma Trg_last_eqI:
     assumes "cong T U"
     shows "\<Lambda>.Trg (last T) = \<Lambda>.Trg (last U)"
     proof -
       have 1: "[\<Lambda>.Trg (last T)] \<in> targets T \<and> [\<Lambda>.Trg (last U)] \<in> targets U"
         using assms
         by (metis Con_implies_Arr(1) Ide.simps(1) ide_char single_Trg_last_in_targets)
       have "\<Lambda>.cong (\<Lambda>.Trg (last T)) (\<Lambda>.Trg (last U))"
         by (metis "1" Ide.simps(2) Resid.simps(3) assms con_char cong_implies_coterminal
             coterminal_iff ide_char prfx_implies_con targets_are_cong)
       moreover have "\<Lambda>.Ide (\<Lambda>.Trg (last T)) \<and> \<Lambda>.Ide (\<Lambda>.Trg (last U))"
         using "1" Ide.simps(2) ide_char by blast
       ultimately show ?thesis
         using \<Lambda>.weak_extensionality by blast
     qed
 
     lemma Trg_last_Src_hd_eqI:
     assumes "seq T U"
     shows "\<Lambda>.Trg (last T) = \<Lambda>.Src (hd U)"
       using assms Arr_imp_arr_hd Arr_imp_arr_last \<Lambda>.Ide_Src \<Lambda>.weak_extensionality \<Lambda>.Ide_Trg
             seq_char seq_imp_cong_Trg_last_Src_hd
       by force
 
     lemma seqI\<^sub>\<Lambda>\<^sub>P [intro]:
     assumes "Arr T" and "Arr U" and "\<Lambda>.Trg (last T) = \<Lambda>.Src (hd U)"
     shows "seq T U"
       by (metis assms Arr_imp_arr_last Srcs_simp\<^sub>\<Lambda>\<^sub>P \<Lambda>.arr_char \<Lambda>.targets_char\<^sub>\<Lambda>
           Trgs_simp\<^sub>P seq_char)
 
     lemma conI\<^sub>\<Lambda>\<^sub>P [intro]:
     assumes "arr T" and "arr U" and "\<Lambda>.Src (hd T) = \<Lambda>.Src (hd U)"
     shows "T \<^sup>*\<frown>\<^sup>* U"
       using assms
       by (simp add: Srcs_simp\<^sub>\<Lambda>\<^sub>P arr_char con_char confluence_ind)
 
     subsection "Mapping Constructors over Paths"
 
     lemma Arr_map_Lam:
     assumes "Arr T"
     shows "Arr (map \<Lambda>.Lam T)"
     proof -
       interpret Lam: simulation \<Lambda>.resid \<Lambda>.resid \<open>\<lambda>t. if \<Lambda>.arr t then \<^bold>\<lambda>\<^bold>[t\<^bold>] else \<^bold>\<sharp>\<close>
         using \<Lambda>.Lam_is_simulation by simp
       interpret simulation Resid Resid
                   \<open>\<lambda>T. if Arr T then map (\<lambda>t. if \<Lambda>.arr t then \<^bold>\<lambda>\<^bold>[t\<^bold>] else \<^bold>\<sharp>) T else []\<close>
         using assms Lam.lifts_to_paths by blast
       have "map (\<lambda>t. if \<Lambda>.Arr t then \<^bold>\<lambda>\<^bold>[t\<^bold>] else \<^bold>\<sharp>) T = map \<Lambda>.Lam T"
         using assms set_Arr_subset_arr by fastforce
       thus ?thesis
         using assms preserves_reflects_arr [of T] arr_char
         by (simp add: \<open>map (\<lambda>t. if \<Lambda>.Arr t then \<^bold>\<lambda>\<^bold>[t\<^bold>] else \<^bold>\<sharp>) T = map \<Lambda>.Lam T\<close>)
     qed
 
     lemma Arr_map_App1:
     assumes "\<Lambda>.Ide b" and "Arr T"
     shows "Arr (map (\<lambda>t. t \<^bold>\<circ> b) T)"
     proof -
       interpret App1: simulation \<Lambda>.resid \<Lambda>.resid \<open>\<lambda>t. if \<Lambda>.arr t then t \<^bold>\<circ> b else \<^bold>\<sharp>\<close>
         using assms \<Lambda>.App_is_simulation1 [of b] by simp
       interpret simulation Resid Resid
                   \<open>\<lambda>T. if Arr T then map (\<lambda>t. if \<Lambda>.arr t then t \<^bold>\<circ> b else \<^bold>\<sharp>) T else []\<close>
         using assms App1.lifts_to_paths by blast
       have "map (\<lambda>t. if \<Lambda>.arr t then t \<^bold>\<circ> b else \<^bold>\<sharp>) T = map (\<lambda>t. t \<^bold>\<circ> b) T"
         using assms set_Arr_subset_arr by auto
       thus ?thesis
         using assms preserves_reflects_arr arr_char
         by (metis (mono_tags, lifting))
     qed
 
     lemma Arr_map_App2:
     assumes "\<Lambda>.Ide a" and "Arr T"
     shows "Arr (map (\<Lambda>.App a) T)"
     proof -
       interpret App2: simulation \<Lambda>.resid \<Lambda>.resid \<open>\<lambda>u. if \<Lambda>.arr u then a \<^bold>\<circ> u else \<^bold>\<sharp>\<close>
         using assms \<Lambda>.App_is_simulation2 by simp
       interpret simulation Resid Resid
                   \<open>\<lambda>T. if Arr T then map (\<lambda>u. if \<Lambda>.arr u then a \<^bold>\<circ> u else \<^bold>\<sharp>) T else []\<close>
         using assms App2.lifts_to_paths by blast
       have "map (\<lambda>u. if \<Lambda>.arr u then a \<^bold>\<circ> u else \<^bold>\<sharp>) T = map (\<lambda>u. a \<^bold>\<circ> u) T"
         using assms set_Arr_subset_arr by auto
       thus ?thesis
         using assms preserves_reflects_arr arr_char
         by (metis (mono_tags, lifting))
     qed
 
     interpretation \<Lambda>\<^sub>L\<^sub>a\<^sub>m: sub_rts \<Lambda>.resid \<open>\<lambda>t. \<Lambda>.Arr t \<and> \<Lambda>.is_Lam t\<close>
     proof
      show "\<And>t. \<Lambda>.Arr t \<and> \<Lambda>.is_Lam t \<Longrightarrow> \<Lambda>.arr t"
        by blast
      show "\<And>t. \<Lambda>.Arr t \<and> \<Lambda>.is_Lam t \<Longrightarrow> \<Lambda>.sources t \<subseteq> {t. \<Lambda>.Arr t \<and> \<Lambda>.is_Lam t}"
        by auto
      show "\<lbrakk>\<Lambda>.Arr t \<and> \<Lambda>.is_Lam t; \<Lambda>.Arr u \<and> \<Lambda>.is_Lam u; \<Lambda>.con t u\<rbrakk>
                     \<Longrightarrow> \<Lambda>.Arr (t \\ u) \<and> \<Lambda>.is_Lam (t \\ u)"
              for t u
        apply (cases t; cases u)
                            apply simp_all
        using \<Lambda>.Coinitial_resid_resid
        by presburger
     qed
 
     interpretation un_Lam: simulation \<Lambda>\<^sub>L\<^sub>a\<^sub>m.resid \<Lambda>.resid
                              \<open>\<lambda>t. if \<Lambda>\<^sub>L\<^sub>a\<^sub>m.arr t then \<Lambda>.un_Lam t else \<^bold>\<sharp>\<close>
     proof
       let ?un_Lam = "\<lambda>t. if \<Lambda>\<^sub>L\<^sub>a\<^sub>m.arr t then \<Lambda>.un_Lam t else \<^bold>\<sharp>"
       show "\<And>t. \<not> \<Lambda>\<^sub>L\<^sub>a\<^sub>m.arr t \<Longrightarrow> ?un_Lam t = \<Lambda>.null"
         by auto
       show "\<And>t u. \<Lambda>\<^sub>L\<^sub>a\<^sub>m.con t u \<Longrightarrow> \<Lambda>.con (?un_Lam t) (?un_Lam u)"
         by auto
       show "\<And>t u. \<Lambda>\<^sub>L\<^sub>a\<^sub>m.con t u \<Longrightarrow> ?un_Lam (\<Lambda>\<^sub>L\<^sub>a\<^sub>m.resid t u) = ?un_Lam t \\ ?un_Lam u"
         using \<Lambda>\<^sub>L\<^sub>a\<^sub>m.resid_closed \<Lambda>\<^sub>L\<^sub>a\<^sub>m.resid_def by auto
     qed
 
     lemma Arr_map_un_Lam:
     assumes "Arr T" and "set T \<subseteq> Collect \<Lambda>.is_Lam"
     shows "Arr (map \<Lambda>.un_Lam T)"
     proof -
       have "map (\<lambda>t. if \<Lambda>\<^sub>L\<^sub>a\<^sub>m.arr t then \<Lambda>.un_Lam t else \<^bold>\<sharp>) T = map \<Lambda>.un_Lam T"
         using assms set_Arr_subset_arr by auto
       thus ?thesis
         using assms
         by (metis (no_types, lifting) \<Lambda>\<^sub>L\<^sub>a\<^sub>m.path_reflection \<Lambda>.arr_char mem_Collect_eq
             set_Arr_subset_arr subset_code(1) un_Lam.preserves_paths)
     qed
 
     interpretation \<Lambda>\<^sub>A\<^sub>p\<^sub>p: sub_rts \<Lambda>.resid \<open>\<lambda>t. \<Lambda>.Arr t \<and> \<Lambda>.is_App t\<close>
     proof
       show "\<And>t. \<Lambda>.Arr t \<and> \<Lambda>.is_App t \<Longrightarrow> \<Lambda>.arr t"
         by blast
       show "\<And>t. \<Lambda>.Arr t \<and> \<Lambda>.is_App t \<Longrightarrow> \<Lambda>.sources t \<subseteq> {t. \<Lambda>.Arr t \<and> \<Lambda>.is_App t}"
         by auto
       show "\<lbrakk>\<Lambda>.Arr t \<and> \<Lambda>.is_App t; \<Lambda>.Arr u \<and> \<Lambda>.is_App u; \<Lambda>.con t u\<rbrakk>
                  \<Longrightarrow> \<Lambda>.Arr (t \\ u) \<and> \<Lambda>.is_App (t \\ u)"
             for t u
-        using \<Lambda>.Arr_resid_ind
+        using \<Lambda>.Arr_resid
         by (cases t; cases u) auto
     qed
 
     interpretation un_App1: simulation \<Lambda>\<^sub>A\<^sub>p\<^sub>p.resid \<Lambda>.resid 
                              \<open>\<lambda>t. if \<Lambda>\<^sub>A\<^sub>p\<^sub>p.arr t then \<Lambda>.un_App1 t else \<^bold>\<sharp>\<close>
     proof
       let ?un_App1 = "\<lambda>t. if \<Lambda>\<^sub>A\<^sub>p\<^sub>p.arr t then \<Lambda>.un_App1 t else \<^bold>\<sharp>"
       show "\<And>t. \<not> \<Lambda>\<^sub>A\<^sub>p\<^sub>p.arr t \<Longrightarrow> ?un_App1 t = \<Lambda>.null"
         by auto
       show "\<And>t u. \<Lambda>\<^sub>A\<^sub>p\<^sub>p.con t u \<Longrightarrow> \<Lambda>.con (?un_App1 t) (?un_App1 u)"
         by auto
       show "\<Lambda>\<^sub>A\<^sub>p\<^sub>p.con t u \<Longrightarrow> ?un_App1 (\<Lambda>\<^sub>A\<^sub>p\<^sub>p.resid t u) = ?un_App1 t \\ ?un_App1 u"
               for t u
-        using \<Lambda>\<^sub>A\<^sub>p\<^sub>p.resid_def \<Lambda>.Arr_resid_ind
+        using \<Lambda>\<^sub>A\<^sub>p\<^sub>p.resid_def \<Lambda>.Arr_resid
         by (cases t; cases u) auto
     qed
 
     interpretation un_App2: simulation \<Lambda>\<^sub>A\<^sub>p\<^sub>p.resid \<Lambda>.resid 
                              \<open>\<lambda>t. if \<Lambda>\<^sub>A\<^sub>p\<^sub>p.arr t then \<Lambda>.un_App2 t else \<^bold>\<sharp>\<close>
     proof
       let ?un_App2 = "\<lambda>t. if \<Lambda>\<^sub>A\<^sub>p\<^sub>p.arr t then \<Lambda>.un_App2 t else \<^bold>\<sharp>"
       show "\<And>t. \<not> \<Lambda>\<^sub>A\<^sub>p\<^sub>p.arr t \<Longrightarrow> ?un_App2 t = \<Lambda>.null"
         by auto
       show "\<And>t u. \<Lambda>\<^sub>A\<^sub>p\<^sub>p.con t u \<Longrightarrow> \<Lambda>.con (?un_App2 t) (?un_App2 u)"
         by auto
       show "\<Lambda>\<^sub>A\<^sub>p\<^sub>p.con t u \<Longrightarrow> ?un_App2 (\<Lambda>\<^sub>A\<^sub>p\<^sub>p.resid t u) = ?un_App2 t \\ ?un_App2 u"
               for t u
-        using \<Lambda>\<^sub>A\<^sub>p\<^sub>p.resid_def \<Lambda>.Arr_resid_ind
+        using \<Lambda>\<^sub>A\<^sub>p\<^sub>p.resid_def \<Lambda>.Arr_resid
         by (cases t; cases u) auto
     qed
 
     lemma Arr_map_un_App1:
     assumes "Arr T" and "set T \<subseteq> Collect \<Lambda>.is_App"
     shows "Arr (map \<Lambda>.un_App1 T)"
     proof -
       interpret P\<^sub>A\<^sub>p\<^sub>p: paths_in_rts \<Lambda>\<^sub>A\<^sub>p\<^sub>p.resid
         ..
       interpret un_App1: simulation P\<^sub>A\<^sub>p\<^sub>p.Resid Resid
                           \<open>\<lambda>T. if P\<^sub>A\<^sub>p\<^sub>p.Arr T then
                                  map (\<lambda>t. if \<Lambda>\<^sub>A\<^sub>p\<^sub>p.arr t then \<Lambda>.un_App1 t else \<^bold>\<sharp>) T
                                else []\<close>
         using un_App1.lifts_to_paths by simp
       have 1: "map (\<lambda>t. if \<Lambda>\<^sub>A\<^sub>p\<^sub>p.arr t then \<Lambda>.un_App1 t else \<^bold>\<sharp>) T = map \<Lambda>.un_App1 T"
         using assms set_Arr_subset_arr by auto
       have 2: "P\<^sub>A\<^sub>p\<^sub>p.Arr T"
         using assms set_Arr_subset_arr \<Lambda>\<^sub>A\<^sub>p\<^sub>p.path_reflection [of T] by blast
       hence "arr (if P\<^sub>A\<^sub>p\<^sub>p.Arr T then map (\<lambda>t. if \<Lambda>\<^sub>A\<^sub>p\<^sub>p.arr t then \<Lambda>.un_App1 t else \<^bold>\<sharp>) T else [])"
         using un_App1.preserves_reflects_arr [of T] by blast
       hence "Arr (if P\<^sub>A\<^sub>p\<^sub>p.Arr T then map (\<lambda>t. if \<Lambda>\<^sub>A\<^sub>p\<^sub>p.arr t then \<Lambda>.un_App1 t else \<^bold>\<sharp>) T else [])"
         using arr_char by auto
       hence "Arr (if P\<^sub>A\<^sub>p\<^sub>p.Arr T then map \<Lambda>.un_App1 T else [])"
         using 1 by metis
       thus ?thesis
         using 2 by simp
     qed
 
     lemma Arr_map_un_App2:
     assumes "Arr T" and "set T \<subseteq> Collect \<Lambda>.is_App"
     shows "Arr (map \<Lambda>.un_App2 T)"
     proof -
       interpret P\<^sub>A\<^sub>p\<^sub>p: paths_in_rts \<Lambda>\<^sub>A\<^sub>p\<^sub>p.resid
         ..
       interpret un_App2: simulation P\<^sub>A\<^sub>p\<^sub>p.Resid Resid
                            \<open>\<lambda>T. if P\<^sub>A\<^sub>p\<^sub>p.Arr T then
                                   map (\<lambda>t. if \<Lambda>\<^sub>A\<^sub>p\<^sub>p.arr t then \<Lambda>.un_App2 t else \<^bold>\<sharp>) T
                                 else []\<close>
         using un_App2.lifts_to_paths by simp
       have 1: "map (\<lambda>t. if \<Lambda>\<^sub>A\<^sub>p\<^sub>p.arr t then \<Lambda>.un_App2 t else \<^bold>\<sharp>) T = map \<Lambda>.un_App2 T"
         using assms set_Arr_subset_arr by auto
       have 2: "P\<^sub>A\<^sub>p\<^sub>p.Arr T"
         using assms set_Arr_subset_arr \<Lambda>\<^sub>A\<^sub>p\<^sub>p.path_reflection [of T] by blast
       hence "arr (if P\<^sub>A\<^sub>p\<^sub>p.Arr T then map (\<lambda>t. if \<Lambda>\<^sub>A\<^sub>p\<^sub>p.arr t then \<Lambda>.un_App2 t else \<^bold>\<sharp>) T else [])"
         using un_App2.preserves_reflects_arr [of T] by blast
       hence "Arr (if P\<^sub>A\<^sub>p\<^sub>p.Arr T then map (\<lambda>t. if \<Lambda>\<^sub>A\<^sub>p\<^sub>p.arr t then \<Lambda>.un_App2 t else \<^bold>\<sharp>) T else [])"
         using arr_char by blast
       hence "Arr (if P\<^sub>A\<^sub>p\<^sub>p.Arr T then map \<Lambda>.un_App2 T else [])"
         using 1 by metis
       thus ?thesis
         using 2 by simp
     qed
 
     lemma map_App_map_un_App1:
     shows "\<lbrakk>Arr U; set U \<subseteq> Collect \<Lambda>.is_App; \<Lambda>.Ide b; \<Lambda>.un_App2 ` set U \<subseteq> {b}\<rbrakk> \<Longrightarrow>
               map (\<lambda>t. \<Lambda>.App t b) (map \<Lambda>.un_App1 U) = U"
       by (induct U) auto
 
     lemma map_App_map_un_App2:
     shows "\<lbrakk>Arr U; set U \<subseteq> Collect \<Lambda>.is_App; \<Lambda>.Ide a; \<Lambda>.un_App1 ` set U \<subseteq> {a}\<rbrakk> \<Longrightarrow>
               map (\<Lambda>.App a) (map \<Lambda>.un_App2 U) = U"
       by (induct U) auto
 
     lemma map_Lam_Resid:
     assumes "coinitial T U"
     shows "map \<Lambda>.Lam (T \<^sup>*\\\<^sup>* U) = map \<Lambda>.Lam T \<^sup>*\\\<^sup>* map \<Lambda>.Lam U"
     proof -
       interpret Lam: simulation \<Lambda>.resid \<Lambda>.resid \<open>\<lambda>t. if \<Lambda>.arr t then \<^bold>\<lambda>\<^bold>[t\<^bold>] else \<^bold>\<sharp>\<close>
         using \<Lambda>.Lam_is_simulation by simp
       interpret Lamx: simulation Resid Resid
                         \<open>\<lambda>T. if Arr T then
                                map (\<lambda>t. if \<Lambda>.arr t then \<^bold>\<lambda>\<^bold>[t\<^bold>] else \<^bold>\<sharp>) T
                          else []\<close>
         using Lam.lifts_to_paths by simp
       have "\<And>T. Arr T \<Longrightarrow> map (\<lambda>t. if \<Lambda>.arr t then \<^bold>\<lambda>\<^bold>[t\<^bold>] else \<^bold>\<sharp>) T = map \<Lambda>.Lam T"
         using set_Arr_subset_arr by auto
       moreover have "Arr (T \<^sup>*\\\<^sup>* U)"
         using assms confluence\<^sub>P Con_imp_Arr_Resid con_char by force
       moreover have "T \<^sup>*\<frown>\<^sup>* U"
         using assms confluence by simp
       moreover have "Arr T \<and> Arr U"
         using assms arr_char by auto
       ultimately show ?thesis
         using assms Lamx.preserves_resid [of T U] by presburger
     qed
 
     lemma map_App1_Resid:
     assumes "\<Lambda>.Ide x" and "coinitial T U"
     shows "map (\<Lambda>.App x) (T \<^sup>*\\\<^sup>* U) = map (\<Lambda>.App x) T \<^sup>*\\\<^sup>* map (\<Lambda>.App x) U"
     proof -
       interpret App: simulation \<Lambda>.resid \<Lambda>.resid \<open>\<lambda>t. if \<Lambda>.arr t then x \<^bold>\<circ> t else \<^bold>\<sharp>\<close>
         using assms \<Lambda>.App_is_simulation2 by simp
       interpret Appx: simulation Resid Resid
                         \<open>\<lambda>T. if Arr T then map (\<lambda>t. if \<Lambda>.arr t then x \<^bold>\<circ> t else \<^bold>\<sharp>) T else []\<close>
         using App.lifts_to_paths by simp
       have "\<And>T. Arr T \<Longrightarrow> map (\<lambda>t. if \<Lambda>.arr t then x \<^bold>\<circ> t else \<^bold>\<sharp>) T = map (\<Lambda>.App x) T"
         using set_Arr_subset_arr by auto
       moreover have "Arr (T \<^sup>*\\\<^sup>* U)"
         using assms confluence\<^sub>P Con_imp_Arr_Resid con_char by force
       moreover have "T \<^sup>*\<frown>\<^sup>* U"
         using assms confluence by simp
       moreover have "Arr T \<and> Arr U"
         using assms arr_char by auto
       ultimately show ?thesis
         using assms Appx.preserves_resid [of T U] by presburger
     qed
 
     lemma map_App2_Resid:
     assumes "\<Lambda>.Ide x" and "coinitial T U"
     shows "map (\<lambda>t. t \<^bold>\<circ> x) (T \<^sup>*\\\<^sup>* U) = map (\<lambda>t. t \<^bold>\<circ> x) T \<^sup>*\\\<^sup>* map (\<lambda>t. t \<^bold>\<circ> x) U"
     proof -
       interpret App: simulation \<Lambda>.resid \<Lambda>.resid \<open>\<lambda>t. if \<Lambda>.arr t then t \<^bold>\<circ> x else \<^bold>\<sharp>\<close>
         using assms \<Lambda>.App_is_simulation1 by simp
       interpret Appx: simulation Resid Resid
                         \<open>\<lambda>T. if Arr T then map (\<lambda>t. if \<Lambda>.arr t then t \<^bold>\<circ> x else \<^bold>\<sharp>) T else []\<close>
         using App.lifts_to_paths by simp
       have "\<And>T. Arr T \<Longrightarrow> map (\<lambda>t. if \<Lambda>.arr t then t \<^bold>\<circ> x else \<^bold>\<sharp>) T = map (\<lambda>t. t \<^bold>\<circ> x) T"
         using set_Arr_subset_arr by auto
       moreover have "Arr (T \<^sup>*\\\<^sup>* U)"
         using assms confluence\<^sub>P Con_imp_Arr_Resid con_char by force
       moreover have "T \<^sup>*\<frown>\<^sup>* U"
         using assms confluence by simp
       moreover have "Arr T \<and> Arr U"
         using assms arr_char by auto
       ultimately show ?thesis
         using assms Appx.preserves_resid [of T U] by presburger
     qed
 
     lemma cong_map_Lam:
-    shows "\<And>T. T \<^sup>*\<sim>\<^sup>* U \<Longrightarrow> map \<Lambda>.Lam T \<^sup>*\<sim>\<^sup>* map \<Lambda>.Lam U"
-      apply (induct U)
+    shows "T \<^sup>*\<sim>\<^sup>* U \<Longrightarrow> map \<Lambda>.Lam T \<^sup>*\<sim>\<^sup>* map \<Lambda>.Lam U"
+      apply (induct U arbitrary: T)
        apply (simp add: ide_char)
       by (metis map_Lam_Resid cong_implies_coinitial cong_reflexive ideE
           map_is_Nil_conv Con_imp_Arr_Resid arr_char)
 
     lemma cong_map_App1:
-    shows "\<And>x T. \<lbrakk>\<Lambda>.Ide x; T \<^sup>*\<sim>\<^sup>* U\<rbrakk> \<Longrightarrow> map (\<Lambda>.App x) T \<^sup>*\<sim>\<^sup>* map (\<Lambda>.App x) U"
-      apply (induct U)
+    shows "\<lbrakk>\<Lambda>.Ide x; T \<^sup>*\<sim>\<^sup>* U\<rbrakk> \<Longrightarrow> map (\<Lambda>.App x) T \<^sup>*\<sim>\<^sup>* map (\<Lambda>.App x) U"
+      apply (induct U arbitrary: x T)
        apply (simp add: ide_char)
       apply (intro conjI)
       by (metis Nil_is_map_conv arr_resid_iff_con con_char con_imp_coinitial
                 cong_reflexive ideE map_App1_Resid)+
 
     lemma cong_map_App2:
-    shows "\<And>x T. \<lbrakk>\<Lambda>.Ide x; T \<^sup>*\<sim>\<^sup>* U\<rbrakk> \<Longrightarrow> map (\<lambda>X. X \<^bold>\<circ> x) T \<^sup>*\<sim>\<^sup>* map (\<lambda>X. X \<^bold>\<circ> x) U"
-      apply (induct U)
+    shows "\<lbrakk>\<Lambda>.Ide x; T \<^sup>*\<sim>\<^sup>* U\<rbrakk> \<Longrightarrow> map (\<lambda>X. X \<^bold>\<circ> x) T \<^sup>*\<sim>\<^sup>* map (\<lambda>X. X \<^bold>\<circ> x) U"
+      apply (induct U arbitrary: x T)
        apply (simp add: ide_char)
       apply (intro conjI)
       by (metis Nil_is_map_conv arr_resid_iff_con con_char cong_implies_coinitial
                    cong_reflexive ide_def arr_char ideE map_App2_Resid)+
 
     subsection "Decomposition of `App Paths'"
 
     text \<open>
       The following series of results is aimed at showing that a reduction path, all of whose
       transitions have \<open>App\<close> as their top-level constructor, can be factored up to congruence
       into a reduction path in which only the ``rator'' components are reduced, followed
       by a reduction path in which only the ``rand'' components are reduced.
     \<close>
 
     lemma orthogonal_App_single_single:
     assumes "\<Lambda>.Arr t" and "\<Lambda>.Arr u"
     shows "[\<Lambda>.Src t \<^bold>\<circ> u] \<^sup>*\\\<^sup>* [t \<^bold>\<circ> \<Lambda>.Src u] = [\<Lambda>.Trg t \<^bold>\<circ> u]"
     and "[t \<^bold>\<circ> \<Lambda>.Src u] \<^sup>*\\\<^sup>* [\<Lambda>.Src t \<^bold>\<circ> u] = [t \<^bold>\<circ> \<Lambda>.Trg u]"
       using assms arr_char \<Lambda>.Arr_not_Nil by auto
 
     lemma orthogonal_App_single_Arr:
-    shows "\<And>t. \<lbrakk>Arr [t]; Arr U\<rbrakk> \<Longrightarrow>
-                  map (\<Lambda>.App (\<Lambda>.Src t)) U \<^sup>*\\\<^sup>* [t \<^bold>\<circ> \<Lambda>.Src (hd U)] = map (\<Lambda>.App (\<Lambda>.Trg t)) U \<and>
-                  [t \<^bold>\<circ> \<Lambda>.Src (hd U)] \<^sup>*\\\<^sup>* map (\<Lambda>.App (\<Lambda>.Src t)) U = [t \<^bold>\<circ> \<Lambda>.Trg (last U)]"
-    proof (induct U)
+    shows "\<lbrakk>Arr [t]; Arr U\<rbrakk> \<Longrightarrow>
+              map (\<Lambda>.App (\<Lambda>.Src t)) U \<^sup>*\\\<^sup>* [t \<^bold>\<circ> \<Lambda>.Src (hd U)] = map (\<Lambda>.App (\<Lambda>.Trg t)) U \<and>
+              [t \<^bold>\<circ> \<Lambda>.Src (hd U)] \<^sup>*\\\<^sup>* map (\<Lambda>.App (\<Lambda>.Src t)) U = [t \<^bold>\<circ> \<Lambda>.Trg (last U)]"
+    proof (induct U arbitrary: t)
       show "\<And>t. \<lbrakk>Arr [t]; Arr []\<rbrakk> \<Longrightarrow>
                    map (\<Lambda>.App (\<Lambda>.Src t)) [] \<^sup>*\\\<^sup>* [t \<^bold>\<circ> \<Lambda>.Src (hd [])] = map (\<Lambda>.App (\<Lambda>.Trg t)) [] \<and>
                    [t \<^bold>\<circ> \<Lambda>.Src (hd [])] \<^sup>*\\\<^sup>* map (\<Lambda>.App (\<Lambda>.Src t)) [] = [t \<^bold>\<circ> \<Lambda>.Trg (last [])]"
         by fastforce
       fix t u U
       assume ind: "\<And>t. \<lbrakk>Arr [t]; Arr U\<rbrakk> \<Longrightarrow>
                          map (\<Lambda>.App (\<Lambda>.Src t)) U \<^sup>*\\\<^sup>* [t \<^bold>\<circ> \<Lambda>.Src (hd U)] =
                          map (\<Lambda>.App (\<Lambda>.Trg t)) U \<and>
                          [t \<^bold>\<circ> \<Lambda>.Src (hd U)] \<^sup>*\\\<^sup>* map (\<Lambda>.App (\<Lambda>.Src t)) U = [t \<^bold>\<circ> \<Lambda>.Trg (last U)]"
       assume t: "Arr [t]"
       assume uU: "Arr (u # U)"
       show "map (\<Lambda>.App (\<Lambda>.Src t)) (u # U) \<^sup>*\\\<^sup>* [t \<^bold>\<circ> \<Lambda>.Src (hd (u # U))] =
             map (\<Lambda>.App (\<Lambda>.Trg t)) (u # U) \<and>
             [t \<^bold>\<circ> \<Lambda>.Src (hd (u # U))] \<^sup>*\\\<^sup>* map (\<Lambda>.App (\<Lambda>.Src t)) (u # U) =
             [t \<^bold>\<circ> \<Lambda>.Trg (last (u # U))]"
       proof (cases "U = []")
         show "U = [] \<Longrightarrow> ?thesis"
           using t uU orthogonal_App_single_single by simp
         assume U: "U \<noteq> []"
         have 2: "coinitial ([\<Lambda>.Src t \<^bold>\<circ> u] @ map (\<Lambda>.App (\<Lambda>.Src t)) U) [t \<^bold>\<circ> \<Lambda>.Src u]"
         proof
           show 3: "arr ([\<Lambda>.Src t \<^bold>\<circ> u] @ map (\<Lambda>.App (\<Lambda>.Src t)) U)"
             using t uU
             by (metis Arr_iff_Con_self Arr_map_App2 Con_rec(1) append_Cons append_Nil arr_char
                 \<Lambda>.Con_implies_Arr2 \<Lambda>.Ide_Src \<Lambda>.con_char list.simps(9))
           show "sources ([\<Lambda>.Src t \<^bold>\<circ> u] @ map (\<Lambda>.App (\<Lambda>.Src t)) U) = sources [t \<^bold>\<circ> \<Lambda>.Src u]"
           proof -
             have "seq [\<Lambda>.Src t \<^bold>\<circ> u] (map (\<Lambda>.App (\<Lambda>.Src t)) U)"
               using U 3 arr_append_imp_seq by force
             thus ?thesis
               using sources_append [of "[\<Lambda>.Src t \<^bold>\<circ> u]" "map (\<Lambda>.App (\<Lambda>.Src t)) U"]
                     sources_single_Src [of "\<Lambda>.Src t \<^bold>\<circ> u"]
                     sources_single_Src [of "t \<^bold>\<circ> \<Lambda>.Src u"]
               using arr_char t
               by (simp add: seq_char)
           qed
         qed
         show ?thesis
         proof
           show 4: "map (\<Lambda>.App (\<Lambda>.Src t)) (u # U) \<^sup>*\\\<^sup>* [t \<^bold>\<circ> \<Lambda>.Src (hd (u # U))] =
                    map (\<Lambda>.App (\<Lambda>.Trg t)) (u # U)"
           proof -
             have "map (\<Lambda>.App (\<Lambda>.Src t)) (u # U) \<^sup>*\\\<^sup>* [t \<^bold>\<circ> \<Lambda>.Src (hd (u # U))] =
                   ([\<Lambda>.Src t \<^bold>\<circ> u] @ map (\<Lambda>.App (\<Lambda>.Src t)) U) \<^sup>*\\\<^sup>* [t \<^bold>\<circ> \<Lambda>.Src u]"
               by simp
             also have "... = [\<Lambda>.Src t \<^bold>\<circ> u] \<^sup>*\\\<^sup>* [t \<^bold>\<circ> \<Lambda>.Src u] @
                                map (\<Lambda>.App (\<Lambda>.Src t)) U \<^sup>*\\\<^sup>* ([t \<^bold>\<circ> \<Lambda>.Src u] \<^sup>*\\\<^sup>* [\<Lambda>.Src t \<^bold>\<circ> u])"
               by (meson "2" Resid_append(1) con_char confluence not_Cons_self2)
             also have "... = [\<Lambda>.Trg t \<^bold>\<circ> u] @ map (\<Lambda>.App (\<Lambda>.Src t)) U \<^sup>*\\\<^sup>* [t \<^bold>\<circ> \<Lambda>.Trg u]"
               using t \<Lambda>.Arr_not_Nil
               by (metis Arr_imp_arr_hd \<Lambda>.arr_char list.sel(1) orthogonal_App_single_single(1)
                   orthogonal_App_single_single(2) uU)
             also have "... = [\<Lambda>.Trg t \<^bold>\<circ> u] @ map (\<Lambda>.App (\<Lambda>.Trg t)) U"
             proof -
               have "\<Lambda>.Src (hd U) = \<Lambda>.Trg u"
                 using U uU Arr.elims(2) Srcs_simp\<^sub>\<Lambda>\<^sub>P by force
               thus ?thesis
                 using t uU ind Arr.elims(2) by fastforce
             qed
             also have "... = map (\<Lambda>.App (\<Lambda>.Trg t)) (u # U)"
               by auto
             finally show ?thesis by blast
           qed
           show "[t \<^bold>\<circ> \<Lambda>.Src (hd (u # U))] \<^sup>*\\\<^sup>* map (\<Lambda>.App (\<Lambda>.Src t)) (u # U) =
                 [t \<^bold>\<circ> \<Lambda>.Trg (last (u # U))]"
           proof -
             have "[t \<^bold>\<circ> \<Lambda>.Src (hd (u # U))] \<^sup>*\\\<^sup>* map (\<Lambda>.App (\<Lambda>.Src t)) (u # U) =
                   ([t \<^bold>\<circ> \<Lambda>.Src (hd (u # U))] \<^sup>*\\\<^sup>* [\<Lambda>.Src t \<^bold>\<circ> u]) \<^sup>*\\\<^sup>* map (\<Lambda>.App (\<Lambda>.Src t)) U"
               by (metis U 4 Con_sym Resid_cons(2) list.distinct(1) list.simps(9) map_is_Nil_conv)
             also have "... = [t \<^bold>\<circ> \<Lambda>.Trg u] \<^sup>*\\\<^sup>* map (\<Lambda>.App (\<Lambda>.Src t)) U"
               by (metis Arr_imp_arr_hd lambda_calculus.arr_char list.sel(1)
                   orthogonal_App_single_single(2) t uU)
             also have "... = [t \<^bold>\<circ> \<Lambda>.Trg (last (u # U))]"
               by (metis 2 t U uU Con_Arr_self Con_cons(1) Con_implies_Arr(1) Trg_last_Src_hd_eqI
                   arr_append_imp_seq coinitialE ind \<Lambda>.Src.simps(4) \<Lambda>.Trg.simps(3)
                   \<Lambda>.lambda.inject(3) last.simps list.distinct(1) list.map_sel(1) map_is_Nil_conv)
             finally show ?thesis by blast
           qed
         qed
       qed
     qed
 
     lemma orthogonal_App_Arr_Arr:
-    shows "\<And>U. \<lbrakk>Arr T; Arr U\<rbrakk> \<Longrightarrow>
-                  map (\<Lambda>.App (\<Lambda>.Src (hd T))) U \<^sup>*\\\<^sup>* map (\<lambda>X. \<Lambda>.App X (\<Lambda>.Src (hd U))) T =
-                  map (\<Lambda>.App (\<Lambda>.Trg (last T))) U \<and>
-                  map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (hd U)) T \<^sup>*\\\<^sup>* map (\<Lambda>.App (\<Lambda>.Src (hd T))) U =
-                  map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last U)) T"
-    proof (induct T)
+    shows "\<lbrakk>Arr T; Arr U\<rbrakk> \<Longrightarrow>
+              map (\<Lambda>.App (\<Lambda>.Src (hd T))) U \<^sup>*\\\<^sup>* map (\<lambda>X. \<Lambda>.App X (\<Lambda>.Src (hd U))) T =
+              map (\<Lambda>.App (\<Lambda>.Trg (last T))) U \<and>
+              map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (hd U)) T \<^sup>*\\\<^sup>* map (\<Lambda>.App (\<Lambda>.Src (hd T))) U =
+              map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last U)) T"
+    proof (induct T arbitrary: U)
       show "\<And>U. \<lbrakk>Arr []; Arr U\<rbrakk>
                   \<Longrightarrow> map (\<Lambda>.App (\<Lambda>.Src (hd []))) U \<^sup>*\\\<^sup>* map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (hd U)) [] =
                       map (\<Lambda>.App (\<Lambda>.Trg (last []))) U \<and>
                       map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (hd U)) [] \<^sup>*\\\<^sup>* map (\<Lambda>.App (\<Lambda>.Src (hd []))) U =
                       map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last U)) []"
         by simp
       fix t T U
       assume ind: "\<And>U. \<lbrakk>Arr T; Arr U\<rbrakk>
                           \<Longrightarrow> map (\<Lambda>.App (\<Lambda>.Src (hd T))) U \<^sup>*\\\<^sup>*
                                 map (\<lambda>X. \<Lambda>.App X (\<Lambda>.Src (hd U))) T =
                               map (\<Lambda>.App (\<Lambda>.Trg (last T))) U \<and>
                               map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (hd U)) T \<^sup>*\\\<^sup>* map (\<Lambda>.App (\<Lambda>.Src (hd T))) U =
                               map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last U)) T"
       assume tT: "Arr (t # T)"
       assume U: "Arr U"
       show "map (\<Lambda>.App (\<Lambda>.Src (hd (t # T)))) U \<^sup>*\\\<^sup>* map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (hd U)) (t # T) =
             map (\<Lambda>.App (\<Lambda>.Trg (last (t # T)))) U \<and>
             map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (hd U)) (t # T) \<^sup>*\\\<^sup>* map (\<Lambda>.App (\<Lambda>.Src (hd (t # T)))) U =
             map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last U)) (t # T)"
       proof (cases "T = []")
         show "T = [] \<Longrightarrow> ?thesis"
           using tT U
           by (simp add: orthogonal_App_single_Arr)
         assume T: "T \<noteq> []"
         have 1: "Arr T"
           using T tT Arr_imp_Arr_tl by fastforce
         have 2: "\<Lambda>.Src (hd T) = \<Lambda>.Trg t"
           using tT T Arr.elims(2) Srcs_simp\<^sub>\<Lambda>\<^sub>P by force
         show ?thesis
         proof
           show 3: "map (\<Lambda>.App (\<Lambda>.Src (hd (t # T)))) U \<^sup>*\\\<^sup>*
                      map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (hd U)) (t # T) =
                    map (\<Lambda>.App (\<Lambda>.Trg (last (t # T)))) U"
           proof -
             have "map (\<Lambda>.App (\<Lambda>.Src (hd (t # T)))) U \<^sup>*\\\<^sup>* map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (hd U)) (t # T) =
                   map (\<Lambda>.App (\<Lambda>.Src t)) U \<^sup>*\\\<^sup>*
                   ([\<Lambda>.App t (\<Lambda>.Src (hd U))] @ map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (hd U)) T)"
               using tT U by simp
             also have "... = (map (\<Lambda>.App (\<Lambda>.Src t)) U \<^sup>*\\\<^sup>* [t \<^bold>\<circ> \<Lambda>.Src (hd U)]) \<^sup>*\\\<^sup>*
                              map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (hd U)) T"
               using tT U Resid_append(2)
               by (metis Con_appendI(2) Resid.simps(1) T map_is_Nil_conv not_Cons_self2)
             also have "... = map (\<Lambda>.App (\<Lambda>.Trg t)) U \<^sup>*\\\<^sup>* map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (hd U)) T"
               using tT U orthogonal_App_single_Arr Arr_imp_arr_hd by fastforce
             also have "... = map (\<Lambda>.App (\<Lambda>.Trg (last (t # T)))) U"
               using tT U 1 2 ind by auto
             finally show ?thesis by blast
           qed
           show "map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (hd U)) (t # T) \<^sup>*\\\<^sup>*
                   map (\<Lambda>.App (\<Lambda>.Src (hd (t # T)))) U =
                 map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last U)) (t # T)"
           proof -
             have "map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (hd U)) (t # T) \<^sup>*\\\<^sup>*
                     map (\<Lambda>.App (\<Lambda>.Src (hd (t # T)))) U =
                   ([t \<^bold>\<circ> \<Lambda>.Src (hd U)] @ map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (hd U)) T) \<^sup>*\\\<^sup>*
                     map (\<Lambda>.App (\<Lambda>.Src t)) U"
               using tT U by simp
             also have "... = ([t \<^bold>\<circ> \<Lambda>.Src (hd U)] \<^sup>*\\\<^sup>* map (\<Lambda>.App (\<Lambda>.Src t)) U) @
                              (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (hd U)) T \<^sup>*\\\<^sup>*
                                  (map (\<Lambda>.App (\<Lambda>.Src t)) U \<^sup>*\\\<^sup>* [t \<^bold>\<circ> \<Lambda>.Src (hd U)]))"
               using tT U 3 Con_sym
                     Resid_append(1)
                       [of "[t \<^bold>\<circ> \<Lambda>.Src (hd U)]" "map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (hd U)) T"
                        "map (\<Lambda>.App (\<Lambda>.Src t)) U"]
               by fastforce
             also have "... = [t \<^bold>\<circ> \<Lambda>.Trg (last U)] @
                                map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (hd U)) T \<^sup>*\\\<^sup>* map (\<Lambda>.App (\<Lambda>.Trg t)) U"
               using tT U Arr_imp_arr_hd orthogonal_App_single_Arr by fastforce
             also have "... = [t \<^bold>\<circ> \<Lambda>.Trg (last U)] @ map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last U)) T"
               using tT U "1" "2" ind by presburger
             also have "... = map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last U)) (t # T)"
               by simp
             finally show ?thesis by blast
           qed
         qed
       qed
     qed
 
     lemma orthogonal_App_cong:
     assumes "Arr T" and "Arr U"
     shows "map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (hd U)) T @ map (\<Lambda>.App (\<Lambda>.Trg (last T))) U \<^sup>*\<sim>\<^sup>*
            map (\<Lambda>.App (\<Lambda>.Src (hd T))) U @ map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last U)) T"
     (*
       using assms orthogonal_App_Arr_Arr [of T U]
       by (smt (verit, best) Con_Arr_self Con_imp_Arr_Resid Con_implies_Arr(1) Con_sym
           Nil_is_append_conv Resid_append_ind arr_char cube map_is_Nil_conv prfx_reflexive)
      *)
     proof
       have 1: "Arr (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (hd U)) T)"
         using assms Arr_imp_arr_hd Arr_map_App1 \<Lambda>.Ide_Src by force
       have 2: "Arr (map (\<Lambda>.App (\<Lambda>.Trg (last T))) U)"
         using assms Arr_imp_arr_last Arr_map_App2 \<Lambda>.Ide_Trg by force
       have 3: "Arr (map (\<Lambda>.App (\<Lambda>.Src (hd T))) U)"
         using assms Arr_imp_arr_hd Arr_map_App2 \<Lambda>.Ide_Src by force
       have 4: "Arr (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last U)) T)"
         using assms Arr_imp_arr_last Arr_map_App1 \<Lambda>.Ide_Trg by force
       have 5: "Arr (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (hd U)) T @ map (\<Lambda>.App (\<Lambda>.Trg (last T))) U)"
         using assms
         by (metis (no_types, lifting) 1 2 Arr.simps(2) Arr_has_Src Arr_imp_arr_last
             Srcs.simps(1) Srcs_Resid_Arr_single Trgs_simp\<^sub>P arr_append arr_char last_map
             orthogonal_App_single_Arr seq_char)
       have 6: "Arr (map (\<Lambda>.App (\<Lambda>.Src (hd T))) U @ map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last U)) T)"
         using assms
         by (metis (no_types, lifting) 3 4 Arr.simps(2) Arr_has_Src Arr_imp_arr_hd
             Srcs.simps(1) Srcs.simps(2) Srcs_Resid Srcs_simp\<^sub>P arr_append arr_char hd_map
             orthogonal_App_single_Arr seq_char)
       have 7: "Con (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (hd U)) T @ map ((\<^bold>\<circ>) (\<Lambda>.Trg (last T))) U)
                    (map ((\<^bold>\<circ>) (\<Lambda>.Src (hd T))) U @ map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last U)) T)"
         using assms orthogonal_App_Arr_Arr [of T U]
         by (metis 1 2 5 6 Con_imp_eq_Srcs Resid.simps(1) Srcs_append confluence_ind)
       have 8: "Con (map ((\<^bold>\<circ>) (\<Lambda>.Src (hd T))) U @ map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last U)) T)
                    (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (hd U)) T @ map ((\<^bold>\<circ>) (\<Lambda>.Trg (last T))) U)"
         using 7 Con_sym by simp
       show "map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (hd U)) T @ map ((\<^bold>\<circ>) (\<Lambda>.Trg (last T))) U \<^sup>*\<lesssim>\<^sup>*
             map ((\<^bold>\<circ>) (\<Lambda>.Src (hd T))) U @ map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last U)) T"
       proof -
         have "(map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (hd U)) T @ map ((\<^bold>\<circ>) (\<Lambda>.Trg (last T))) U) \<^sup>*\\\<^sup>*
                 (map ((\<^bold>\<circ>) (\<Lambda>.Src (hd T))) U @ map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last U)) T) =
               map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last U)) T \<^sup>*\\\<^sup>* map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last U)) T @
                 (map ((\<^bold>\<circ>) (\<Lambda>.Trg (last T))) U \<^sup>*\\\<^sup>* map ((\<^bold>\<circ>) (\<Lambda>.Trg (last T))) U) \<^sup>*\\\<^sup>*
                    (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last U)) T \<^sup>*\\\<^sup>* map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last U)) T)"
           using assms 7 orthogonal_App_Arr_Arr
                 Resid_append2
                   [of "map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (hd U)) T" "map (\<Lambda>.App (\<Lambda>.Trg (last T))) U"
                       "map (\<Lambda>.App (\<Lambda>.Src (hd T))) U" "map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last U)) T"]
           by fastforce
         moreover have "Ide ..."
           using assms 1 2 3 4 5 6 7 Resid_Arr_self
           by (metis Arr_append_iff\<^sub>P Con_Arr_self Con_imp_Arr_Resid Ide_appendI\<^sub>P
               Resid_Ide_Arr_ind append_Nil2 calculation)
         ultimately show ?thesis
           using ide_char by presburger
       qed
       show "map ((\<^bold>\<circ>) (\<Lambda>.Src (hd T))) U @ map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last U)) T \<^sup>*\<lesssim>\<^sup>*
             map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (hd U)) T @ map ((\<^bold>\<circ>) (\<Lambda>.Trg (last T))) U"
       proof -
         have "map ((\<^bold>\<circ>) (\<Lambda>.Src (hd T))) U \<^sup>*\\\<^sup>* map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (hd U)) T =
               map ((\<^bold>\<circ>) (\<Lambda>.Trg (last T))) U"
           by (simp add: assms orthogonal_App_Arr_Arr)
         have "(map ((\<^bold>\<circ>) (\<Lambda>.Src (hd T))) U @ map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last U)) T) \<^sup>*\\\<^sup>*
                 (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (hd U)) T @ map ((\<^bold>\<circ>) (\<Lambda>.Trg (last T))) U) =
               (map ((\<^bold>\<circ>) (\<Lambda>.Trg (last T))) U) \<^sup>*\\\<^sup>* map ((\<^bold>\<circ>) (\<Lambda>.Trg (last T))) U @
                  (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last U)) T \<^sup>*\\\<^sup>* map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last U)) T) \<^sup>*\\\<^sup>*
                     (map ((\<^bold>\<circ>) (\<Lambda>.Trg (last T))) U \<^sup>*\\\<^sup>* map ((\<^bold>\<circ>) (\<Lambda>.Trg (last T))) U)"
           using assms 8 orthogonal_App_Arr_Arr [of T U]
                 Resid_append2
                   [of "map (\<Lambda>.App (\<Lambda>.Src (hd T))) U" "map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last U)) T"
                       "map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (hd U)) T" "map (\<Lambda>.App (\<Lambda>.Trg (last T))) U"]
           by fastforce
         moreover have "Ide ..."
           using assms 1 2 3 4 5 6 8 Resid_Arr_self Arr_append_iff\<^sub>P Con_sym
           by (metis Con_Arr_self Con_imp_Arr_Resid Ide_appendI\<^sub>P Resid_Ide_Arr_ind
               append_Nil2 calculation)
         ultimately show ?thesis
           using ide_char by presburger
       qed
     qed
 
     text \<open>
       We arrive at the final objective of this section: factorization, up to congruence,
       of a path whose transitions all have \<open>App\<close> as the top-level constructor,
       into the composite of a path that reduces only the ``rators'' and a path
       that reduces only the ``rands''.
     \<close>
 
     lemma map_App_decomp:
     shows "\<lbrakk>Arr U; set U \<subseteq> Collect \<Lambda>.is_App\<rbrakk> \<Longrightarrow>
              map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (\<Lambda>.un_App2 (hd U))) (map \<Lambda>.un_App1 U) @
                map (\<lambda>X. \<Lambda>.Trg (\<Lambda>.un_App1 (last U)) \<^bold>\<circ> X) (map \<Lambda>.un_App2 U) \<^sup>*\<sim>\<^sup>*
              U"
     proof (induct U)
       show "Arr [] \<Longrightarrow> map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (\<Lambda>.un_App2 (hd []))) (map \<Lambda>.un_App1 []) @
                          map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last [])))) (map \<Lambda>.un_App2 []) \<^sup>*\<sim>\<^sup>*
                        []"
         by simp
       fix u U
       assume ind: "\<lbrakk>Arr U; set U \<subseteq> Collect \<Lambda>.is_App\<rbrakk> \<Longrightarrow>
                        map (\<lambda>X. \<Lambda>.App X (\<Lambda>.Src (\<Lambda>.un_App2 (hd U)))) (map \<Lambda>.un_App1 U) @
                          map (\<lambda>X. \<Lambda>.Trg (\<Lambda>.un_App1 (last U)) \<^bold>\<circ> X) (map \<Lambda>.un_App2 U) \<^sup>*\<sim>\<^sup>*
                        U"
       assume uU: "Arr (u # U)"
       assume set: "set (u # U) \<subseteq> Collect \<Lambda>.is_App"
       have u: "\<Lambda>.Arr u \<and> \<Lambda>.is_App u"
         using set set_Arr_subset_arr uU by fastforce
       show "map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (\<Lambda>.un_App2 (hd (u # U)))) (map \<Lambda>.un_App1 (u # U)) @
               map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))))) (map \<Lambda>.un_App2 (u # U)) \<^sup>*\<sim>\<^sup>*
             u # U"
       proof (cases "U = []")
         assume U: "U = []"
         show ?thesis
           using u U \<Lambda>.Con_sym \<Lambda>.Ide_iff_Src_self \<Lambda>.resid_Arr_self \<Lambda>.resid_Src_Arr
                 \<Lambda>.resid_Arr_Src \<Lambda>.Src_resid \<Lambda>.Arr_resid ide_char \<Lambda>.Arr_not_Nil
           by (cases u, simp_all)
         next
         assume U: "U \<noteq> []"
         have 1: "Arr (map \<Lambda>.un_App1 U)"
           using U set Arr_map_un_App1 uU
           by (metis Arr_imp_Arr_tl list.distinct(1) list.map_disc_iff list.map_sel(2) list.sel(3))
         have 2: "Arr [\<Lambda>.un_App2 u]"
           using U uU set
           by (metis Arr.simps(2) Arr_imp_arr_hd Arr_map_un_App2 hd_map list.discI list.sel(1))
         have 3: "\<Lambda>.Arr (\<Lambda>.un_App1 u) \<and> \<Lambda>.Arr (\<Lambda>.un_App2 u)"
           using uU set
           by (metis Arr_imp_arr_hd Arr_map_un_App1 Arr_map_un_App2 \<Lambda>.arr_char
               list.distinct(1) list.map_sel(1) list.sel(1))
         have 4: "map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (\<Lambda>.un_App2 u)) (map \<Lambda>.un_App1 U) @
                    [\<Lambda>.Trg (\<Lambda>.un_App1 (last U)) \<^bold>\<circ> \<Lambda>.un_App2 u] \<^sup>*\<sim>\<^sup>*
                  [\<Lambda>.Src (hd (map \<Lambda>.un_App1 U)) \<^bold>\<circ> \<Lambda>.un_App2 u] @
                    map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last [\<Lambda>.un_App2 u])) (map \<Lambda>.un_App1 U)"
         proof -
           have "map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (hd [\<Lambda>.un_App2 u])) (map \<Lambda>.un_App1 U) =
                 map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (\<Lambda>.un_App2 u)) (map \<Lambda>.un_App1 U)"
             using U uU set by simp
           moreover have "map (\<Lambda>.App (\<Lambda>.Trg (last (map \<Lambda>.un_App1 U)))) [\<Lambda>.un_App2 u] =
                          [\<Lambda>.Trg (\<Lambda>.un_App1 (last U)) \<^bold>\<circ> \<Lambda>.un_App2 u]"
             by (simp add: U last_map)
           moreover have "map (\<Lambda>.App (\<Lambda>.Src (hd (map \<Lambda>.un_App1 U)))) [\<Lambda>.un_App2 u] =
                          [\<Lambda>.Src (hd (map \<Lambda>.un_App1 U)) \<^bold>\<circ> \<Lambda>.un_App2 u]"
             by simp
           moreover have "map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last [\<Lambda>.un_App2 u])) (map \<Lambda>.un_App1 U) =
                          map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last [\<Lambda>.un_App2 u])) (map \<Lambda>.un_App1 U)"
             using U uU set by blast
           ultimately show ?thesis
             using U uU set last_map hd_map 1 2 3
                   orthogonal_App_cong [of "map \<Lambda>.un_App1 U" "[\<Lambda>.un_App2 u]"]
             by presburger
         qed
         have 5: "\<Lambda>.Arr (\<Lambda>.un_App1 u \<^bold>\<circ> \<Lambda>.Src (\<Lambda>.un_App2 u))"
           by (simp add: 3)
         have 6: "Arr (map (\<lambda>X. \<Lambda>.Trg (\<Lambda>.un_App1 (last U)) \<^bold>\<circ> X) (map \<Lambda>.un_App2 U))"
           by (metis 1 Arr_imp_arr_last Arr_map_App2 Arr_map_un_App2 Con_implies_Arr(2)
               Ide.simps(1) Resid_Arr_self Resid_cons(2) U insert_subset
               \<Lambda>.Ide_Trg \<Lambda>.arr_char last_map list.simps(15) set uU)
         have 7: "\<Lambda>.Arr (\<Lambda>.Trg (\<Lambda>.un_App1 (last U)))"
           by (metis 4 Arr.simps(2) Arr_append_iff\<^sub>P Con_implies_Arr(2) Ide.simps(1)
               U ide_char \<Lambda>.Arr.simps(4) \<Lambda>.arr_char list.map_disc_iff not_Cons_self2)
         have 8: "\<Lambda>.Src (hd (map \<Lambda>.un_App1 U)) = \<Lambda>.Trg (\<Lambda>.un_App1 u)"
         proof -
           have "\<Lambda>.Src (hd U) = \<Lambda>.Trg u"
             using u uU U by fastforce
           thus ?thesis
             using u uU U set
             apply (cases u; cases "hd U")
                                 apply (simp_all add: list.map_sel(1))
             using list.set_sel(1)
             by fastforce
         qed
         have 9: "\<Lambda>.Src (\<Lambda>.un_App2 (hd U)) = \<Lambda>.Trg (\<Lambda>.un_App2 u)"
         proof -
           have "\<Lambda>.Src (hd U) = \<Lambda>.Trg u"
             using u uU U by fastforce
           thus ?thesis
             using u uU U set
             apply (cases u; cases "hd U")
                                 apply simp_all
             by (metis lambda_calculus.lambda.disc(15) list.set_sel(1) mem_Collect_eq
                 subset_code(1))
         qed
         have "map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (\<Lambda>.un_App2 (hd (u # U)))) (map \<Lambda>.un_App1 (u # U)) @
                 map ((\<^bold>\<circ>) (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))))) (map \<Lambda>.un_App2 (u # U)) =
               [\<Lambda>.un_App1 u \<^bold>\<circ> \<Lambda>.Src (\<Lambda>.un_App2 u)] @
                 (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (\<Lambda>.un_App2 u))
                      (map \<Lambda>.un_App1 U) @ [\<Lambda>.Trg (\<Lambda>.un_App1 (last U)) \<^bold>\<circ> \<Lambda>.un_App2 u]) @
                   map ((\<^bold>\<circ>) (\<Lambda>.Trg (\<Lambda>.un_App1 (last U)))) (map \<Lambda>.un_App2 U)"
           using uU U by simp
         also have 12: "cong ... ([\<Lambda>.un_App1 u \<^bold>\<circ> \<Lambda>.Src (\<Lambda>.un_App2 u)] @
                                ([\<Lambda>.Src (hd (map \<Lambda>.un_App1 U)) \<^bold>\<circ> \<Lambda>.un_App2 u] @
                                   map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last [\<Lambda>.un_App2 u])) (map \<Lambda>.un_App1 U)) @
                                  map ((\<^bold>\<circ>) (\<Lambda>.Trg (\<Lambda>.un_App1 (last U)))) (map \<Lambda>.un_App2 U))"
         proof (intro cong_append [of "[\<Lambda>.un_App1 u \<^bold>\<circ> \<Lambda>.Src (\<Lambda>.un_App2 u)]"]
                      cong_append [where U = "map (\<lambda>X. \<Lambda>.Trg (\<Lambda>.un_App1 (last U)) \<^bold>\<circ> X)
                                                  (map \<Lambda>.un_App2 U)"])
           show "[\<Lambda>.un_App1 u \<^bold>\<circ> \<Lambda>.Src (\<Lambda>.un_App2 u)] \<^sup>*\<sim>\<^sup>* [\<Lambda>.un_App1 u \<^bold>\<circ> \<Lambda>.Src (\<Lambda>.un_App2 u)]"
             using 5 arr_char cong_reflexive Arr.simps(2) \<Lambda>.arr_char by presburger
           show "map (\<lambda>X. \<Lambda>.Trg (\<Lambda>.un_App1 (last U)) \<^bold>\<circ> X) (map \<Lambda>.un_App2 U) \<^sup>*\<sim>\<^sup>*
                 map (\<lambda>X. \<Lambda>.Trg (\<Lambda>.un_App1 (last U)) \<^bold>\<circ> X) (map \<Lambda>.un_App2 U)"
             using 6 cong_reflexive by auto
           show "map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (\<Lambda>.un_App2 u)) (map \<Lambda>.un_App1 U) @
                   [\<Lambda>.Trg (\<Lambda>.un_App1 (last U)) \<^bold>\<circ> \<Lambda>.un_App2 u] \<^sup>*\<sim>\<^sup>*
                 [\<Lambda>.Src (hd (map \<Lambda>.un_App1 U)) \<^bold>\<circ> \<Lambda>.un_App2 u] @
                   map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last [\<Lambda>.un_App2 u])) (map \<Lambda>.un_App1 U)"
             using 4 by simp
           show 10: "seq [\<Lambda>.un_App1 u \<^bold>\<circ> \<Lambda>.Src (\<Lambda>.un_App2 u)]
                         ((map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (\<Lambda>.un_App2 u)) (map \<Lambda>.un_App1 U) @
                            [\<Lambda>.Trg (\<Lambda>.un_App1 (last U)) \<^bold>\<circ> \<Lambda>.un_App2 u]) @
                              map (\<lambda>X. \<Lambda>.Trg (\<Lambda>.un_App1 (last U)) \<^bold>\<circ> X) (map \<Lambda>.un_App2 U))"
           proof
             show "Arr [\<Lambda>.un_App1 u \<^bold>\<circ> \<Lambda>.Src (\<Lambda>.un_App2 u)]"
               using 5 Arr.simps(2) by blast
             show "Arr ((map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (\<Lambda>.un_App2 u)) (map \<Lambda>.un_App1 U) @
                           [\<Lambda>.Trg (\<Lambda>.un_App1 (last U)) \<^bold>\<circ> \<Lambda>.un_App2 u]) @
                          map (\<lambda>X. \<Lambda>.Trg (\<Lambda>.un_App1 (last U)) \<^bold>\<circ> X) (map \<Lambda>.un_App2 U))"
             proof (intro Arr_appendI\<^sub>P\<^sub>W\<^sub>E)
               show "Arr (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (\<Lambda>.un_App2 u)) (map \<Lambda>.un_App1 U))"
                 using 1 3 Arr_map_App1 lambda_calculus.Ide_Src by blast
               show "Arr [\<Lambda>.Trg (\<Lambda>.un_App1 (last U)) \<^bold>\<circ> \<Lambda>.un_App2 u]"
                 by (simp add: 3 7)
               show "Trg (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (\<Lambda>.un_App2 u)) (map \<Lambda>.un_App1 U)) =
                     Src [\<Lambda>.Trg (\<Lambda>.un_App1 (last U)) \<^bold>\<circ> \<Lambda>.un_App2 u]"
                 by (metis 4 Arr_appendE\<^sub>P\<^sub>W\<^sub>E Con_implies_Arr(2) Ide.simps(1) U ide_char
                     list.map_disc_iff not_Cons_self2)
               show "Arr (map (\<lambda>X. \<Lambda>.Trg (\<Lambda>.un_App1 (last U)) \<^bold>\<circ> X) (map \<Lambda>.un_App2 U))"
                 using 6 by simp
               show "Trg (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (\<Lambda>.un_App2 u)) (map \<Lambda>.un_App1 U) @
                            [\<Lambda>.Trg (\<Lambda>.un_App1 (last U)) \<^bold>\<circ> \<Lambda>.un_App2 u]) =
                     Src (map (\<lambda>X. \<Lambda>.Trg (\<Lambda>.un_App1 (last U)) \<^bold>\<circ> X) (map \<Lambda>.un_App2 U))"
                 using U uU set 1 3 6 7 9 Srcs_simp\<^sub>P\<^sub>W\<^sub>E Arr_imp_arr_hd Arr_imp_arr_last
                 apply auto
                 by (metis Nil_is_map_conv hd_map \<Lambda>.Src.simps(4) \<Lambda>.Src_Trg \<Lambda>.Trg_Trg
                     last_map list.map_comp)
             qed
             show "\<Lambda>.Trg (last [\<Lambda>.un_App1 u \<^bold>\<circ> \<Lambda>.Src (\<Lambda>.un_App2 u)]) =
                   \<Lambda>.Src (hd ((map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (\<Lambda>.un_App2 u)) (map \<Lambda>.un_App1 U) @
                                 [\<Lambda>.Trg (\<Lambda>.un_App1 (last U)) \<^bold>\<circ> \<Lambda>.un_App2 u]) @
                                map (\<lambda>X. \<Lambda>.Trg (\<Lambda>.un_App1 (last U)) \<^bold>\<circ> X) (map \<Lambda>.un_App2 U)))"
               using 8 9
               by (simp add: 3 U hd_map)
           qed
           show "seq (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (\<Lambda>.un_App2 u)) (map \<Lambda>.un_App1 U) @
                       [\<Lambda>.Trg (\<Lambda>.un_App1 (last U)) \<^bold>\<circ> \<Lambda>.un_App2 u])
                     (map (\<lambda>X. \<Lambda>.Trg (\<Lambda>.un_App1 (last U)) \<^bold>\<circ> X) (map \<Lambda>.un_App2 U))"
             by (metis Nil_is_map_conv U 10 append_is_Nil_conv arr_append_imp_seq seqE)
         qed
         also have 11: "[\<Lambda>.un_App1 u \<^bold>\<circ> \<Lambda>.Src (\<Lambda>.un_App2 u)] @
                          ([\<Lambda>.Src (hd (map \<Lambda>.un_App1 U)) \<^bold>\<circ> \<Lambda>.un_App2 u] @
                             map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last [\<Lambda>.un_App2 u])) (map \<Lambda>.un_App1 U)) @
                            map ((\<^bold>\<circ>) (\<Lambda>.Trg (\<Lambda>.un_App1 (last U)))) (map \<Lambda>.un_App2 U) =
                        ([\<Lambda>.un_App1 u \<^bold>\<circ> \<Lambda>.Src (\<Lambda>.un_App2 u)] @
                          [\<Lambda>.Src (hd (map \<Lambda>.un_App1 U)) \<^bold>\<circ> \<Lambda>.un_App2 u]) @
                          map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last [\<Lambda>.un_App2 u])) (map \<Lambda>.un_App1 U) @
                            map ((\<^bold>\<circ>) (\<Lambda>.Trg (\<Lambda>.un_App1 (last U)))) (map \<Lambda>.un_App2 U)"
           by simp
         also have "cong ... ([u] @ U)"
         proof (intro cong_append)
           show "seq ([\<Lambda>.un_App1 u \<^bold>\<circ> \<Lambda>.Src (\<Lambda>.un_App2 u)] @
                        [\<Lambda>.Src (hd (map \<Lambda>.un_App1 U)) \<^bold>\<circ> \<Lambda>.un_App2 u])
                     (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last [\<Lambda>.un_App2 u])) (map \<Lambda>.un_App1 U) @
                        map ((\<^bold>\<circ>) (\<Lambda>.Trg (\<Lambda>.un_App1 (last U)))) (map \<Lambda>.un_App2 U))"
             by (metis 5 11 12 U Arr.simps(1-2) Con_implies_Arr(2) Ide.simps(1) Nil_is_map_conv
                 append_is_Nil_conv arr_append_imp_seq arr_char ide_char \<Lambda>.arr_char)
           show "[\<Lambda>.un_App1 u \<^bold>\<circ> \<Lambda>.Src (\<Lambda>.un_App2 u)] @
                   [\<Lambda>.Src (hd (map \<Lambda>.un_App1 U)) \<^bold>\<circ> \<Lambda>.un_App2 u] \<^sup>*\<sim>\<^sup>*
                 [u]"
           proof -
             have "[\<Lambda>.un_App1 u \<^bold>\<circ> \<Lambda>.Src (\<Lambda>.un_App2 u)] @
                     [\<Lambda>.Trg (\<Lambda>.un_App1 u) \<^bold>\<circ> \<Lambda>.un_App2 u] \<^sup>*\<sim>\<^sup>*
                   [u]"
               using u uU U \<Lambda>.Arr_Trg \<Lambda>.Arr_not_Nil \<Lambda>.resid_Arr_self
               apply (cases u)
                   apply auto
               by force+
             thus ?thesis using 8 by simp
           qed
           show "map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last [\<Lambda>.un_App2 u])) (map \<Lambda>.un_App1 U) @
                   map ((\<^bold>\<circ>) (\<Lambda>.Trg (\<Lambda>.un_App1 (last U)))) (map \<Lambda>.un_App2 U) \<^sup>*\<sim>\<^sup>*
                 U"
             using ind set 9
             apply simp
             using U uU by blast
         qed
         also have "[u] @ U = u # U"
           by simp
         finally show ?thesis by blast
       qed
     qed
 
     subsection "Miscellaneous"
 
     lemma Resid_parallel:
     assumes "cong t t'" and "coinitial t u"
     shows "u \<^sup>*\\\<^sup>* t = u \<^sup>*\\\<^sup>* t'"
     proof -
       have "u \<^sup>*\\\<^sup>* t = (u \<^sup>*\\\<^sup>* t) \<^sup>*\\\<^sup>* (t' \<^sup>*\\\<^sup>* t)"
         using assms
         by (metis con_target conI\<^sub>P con_sym resid_arr_ide)
       also have "... = (u \<^sup>*\\\<^sup>* t') \<^sup>*\\\<^sup>* (t \<^sup>*\\\<^sup>* t')"
         using cube by auto
       also have "... = u \<^sup>*\\\<^sup>* t'"
         using assms
         by (metis con_target conI\<^sub>P con_sym resid_arr_ide)
       finally show ?thesis by blast
     qed
 
     lemma set_Ide_subset_single_hd:
     shows "Ide T \<Longrightarrow> set T \<subseteq> {hd T}"
       apply (induct T, auto)
       using \<Lambda>.coinitial_ide_are_cong
       by (metis Arr_imp_arr_hd Ide_consE Ide_imp_Ide_hd Ide_implies_Arr Srcs_simp\<^sub>P\<^sub>W\<^sub>E Srcs_simp\<^sub>\<Lambda>\<^sub>P
           \<Lambda>.trg_ide equals0D \<Lambda>.Ide_iff_Src_self \<Lambda>.arr_char \<Lambda>.ide_char set_empty singletonD
           subset_code(1))
 
     text \<open>
       A single parallel reduction with \<open>Beta\<close> as the top-level operator factors,
       up to congruence, either as a path in which the top-level redex is
       contracted first, or as a path in which the top-level redex is contracted last.
     \<close>
 
     lemma Beta_decomp:
     assumes "\<Lambda>.Arr t" and "\<Lambda>.Arr u"
     shows "[\<^bold>\<lambda>\<^bold>[\<Lambda>.Src t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src u] @ [\<Lambda>.subst u t] \<^sup>*\<sim>\<^sup>* [\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u]"
     and "[\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<circ> u] @ [\<^bold>\<lambda>\<^bold>[\<Lambda>.Trg t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Trg u] \<^sup>*\<sim>\<^sup>* [\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u]"
       using assms \<Lambda>.Arr_not_Nil \<Lambda>.Subst_not_Nil ide_char \<Lambda>.Ide_Subst \<Lambda>.Ide_Trg
             \<Lambda>.Arr_Subst \<Lambda>.resid_Arr_self
       by auto
 
     text \<open>
       If a reduction path follows an initial reduction whose top-level constructor is \<open>Lam\<close>,
       then all the terms in the path have \<open>Lam\<close> as their top-level constructor.
     \<close>
 
     lemma seq_Lam_Arr_implies:
-    shows "\<And>t. \<lbrakk>seq [t] U; \<Lambda>.is_Lam t\<rbrakk> \<Longrightarrow> set U \<subseteq> Collect \<Lambda>.is_Lam"
-    proof (induct U)
+    shows "\<lbrakk>seq [t] U; \<Lambda>.is_Lam t\<rbrakk> \<Longrightarrow> set U \<subseteq> Collect \<Lambda>.is_Lam"
+    proof (induct U arbitrary: t)
       show "\<And>t. \<lbrakk>seq [t] []; \<Lambda>.is_Lam t\<rbrakk> \<Longrightarrow> set [] \<subseteq> Collect \<Lambda>.is_Lam"
         by simp
       fix u U t
       assume ind: "\<And>t. \<lbrakk>seq [t] U; \<Lambda>.is_Lam t\<rbrakk> \<Longrightarrow> set U \<subseteq> Collect \<Lambda>.is_Lam"
       assume uU: "seq [t] (u # U)"
       assume t: "\<Lambda>.is_Lam t"
       show "set (u # U) \<subseteq> Collect \<Lambda>.is_Lam"
       proof -
         have "\<Lambda>.is_Lam u"
-        proof -
-          have "\<Lambda>.seq t u"
-            by (metis Arr_imp_arr_hd Trg_last_Src_hd_eqI \<Lambda>.arr_char \<Lambda>.seq_char last_ConsL
-                list.sel(1) seq_char uU)
-          thus ?thesis
-            using \<Lambda>.seq_cases t by blast
-        qed
+          by (metis Trg_last_Src_hd_eqI \<Lambda>.Src.simps(1-2,4-5) \<Lambda>.Trg.simps(2) \<Lambda>.is_App_def
+            \<Lambda>.is_Beta_def \<Lambda>.is_Lam_def \<Lambda>.is_Var_def \<Lambda>.lambda.disc(9) \<Lambda>.lambda.exhaust_disc
+            last_ConsL list.sel(1) t uU)
         moreover have "set U \<subseteq> Collect \<Lambda>.is_Lam"
         proof (cases "U = []")
           show "U = [] \<Longrightarrow> ?thesis"
             by simp
           assume U: "U \<noteq> []"
           have "seq [u] U"
             by (metis U append_Cons arr_append_imp_seq not_Cons_self2 self_append_conv2
                 seqE uU)
           thus ?thesis
             using ind calculation by simp
         qed
         ultimately show ?thesis by auto
       qed
     qed
 
     lemma seq_map_un_Lam:
     assumes "seq [\<^bold>\<lambda>\<^bold>[t\<^bold>]] U"
     shows "seq [t] (map \<Lambda>.un_Lam U)"
     proof -
       have "Arr (\<^bold>\<lambda>\<^bold>[t\<^bold>] # U)"
         using assms
         by (simp add: seq_char)
       hence "Arr (map \<Lambda>.un_Lam (\<^bold>\<lambda>\<^bold>[t\<^bold>] # U)) \<and> Arr U"
         using seq_Lam_Arr_implies
         by (metis Arr_map_un_Lam \<open>seq [\<^bold>\<lambda>\<^bold>[t\<^bold>]] U\<close> \<Lambda>.lambda.discI(2) mem_Collect_eq
             seq_char set_ConsD subset_code(1))
       hence "Arr (\<Lambda>.un_Lam \<^bold>\<lambda>\<^bold>[t\<^bold>] # map \<Lambda>.un_Lam U) \<and> Arr U"
         by simp
       thus ?thesis
         using seq_char
         by (metis (no_types, lifting) Arr.simps(1) Con_imp_eq_Srcs Con_implies_Arr(2)
             Con_initial_right Resid_rec(1) Resid_rec(3) Srcs_Resid \<Lambda>.lambda.sel(2)
             map_is_Nil_conv confluence_ind)
     qed
 
   end
 
   section "Developments"
 
   text \<open>
     A \emph{development} is a reduction path from a term in which at each step exactly one
     redex is contracted, and the only redexes that are contracted are those that are residuals
     of redexes present in the original term.  That is, no redexes are contracted that were
     newly created as a result of the previous reductions.  The main theorem about developments
     is the Finite Developments Theorem, which states that all developments are finite.
     A proof of this theorem was published by Hindley \cite{hindley}, who attributes the
     result to Schroer \cite{schroer}.  Other proofs were published subsequently.
     Here we follow the paper by de Vrijer \cite{deVrijer}, which may in some sense be considered
     the definitive work because de Vrijer's proof gives an exact bound on the number of steps
     in a development.  Since de Vrijer used a classical, named-variable representation of
     \<open>\<lambda>\<close>-terms, for the formalization given in the present article it was necessary to find the
     correct way to adapt de Vrijer's proof to the de Bruijn index representation of terms.
     I found this to be a somewhat delicate matter and to my knowledge it has not been done
     previously.
   \<close>
 
   context lambda_calculus
   begin
 
     text \<open>
       We define an \emph{elementary reduction} defined to be a term with exactly one marked redex.
       These correspond to the most basic computational steps.
     \<close>
 
     fun elementary_reduction
     where "elementary_reduction \<^bold>\<sharp> \<longleftrightarrow> False"
         | "elementary_reduction (\<^bold>\<guillemotleft>_\<^bold>\<guillemotright>) \<longleftrightarrow> False"
         | "elementary_reduction \<^bold>\<lambda>\<^bold>[t\<^bold>] \<longleftrightarrow> elementary_reduction t"
         | "elementary_reduction (t \<^bold>\<circ> u) \<longleftrightarrow>
             (elementary_reduction t \<and> Ide u) \<or> (Ide t \<and> elementary_reduction u)"
         | "elementary_reduction (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) \<longleftrightarrow> Ide t \<and> Ide u"
 
     text \<open>
       It is tempting to imagine that elementary reductions would be atoms with respect to the
       preorder \<open>\<lesssim>\<close>, but this is not necessarily the case.
       For example, suppose \<open>t = \<^bold>\<lambda>\<^bold>[\<^bold>\<guillemotleft>1\<^bold>\<guillemotright>\<^bold>] \<^bold>\<Zspot> (\<^bold>\<lambda>\<^bold>[\<^bold>\<guillemotleft>0\<^bold>\<guillemotright>\<^bold>] \<^bold>\<circ> \<^bold>\<guillemotleft>0\<^bold>\<guillemotright>)\<close> and \<open>u = \<^bold>\<lambda>\<^bold>[\<^bold>\<guillemotleft>1\<^bold>\<guillemotright>\<^bold>] \<^bold>\<Zspot> (\<^bold>\<lambda>\<^bold>[\<^bold>\<guillemotleft>0\<^bold>\<guillemotright>\<^bold>] \<^bold>\<Zspot> \<^bold>\<guillemotleft>0\<^bold>\<guillemotright>)\<close>.
       Then \<open>t\<close> is an elementary reduction, \<open>u \<lesssim> t\<close> (in fact \<open>u \<sim> t\<close>) but \<open>u\<close> is not an identity,
       nor is it elementary.
     \<close>
 
     lemma elementary_reduction_is_arr:
     shows "elementary_reduction t \<Longrightarrow> arr t"
       using Ide_implies_Arr arr_char
       by (induct t) auto
 
     lemma elementary_reduction_not_ide:
     shows "elementary_reduction t \<Longrightarrow> \<not> ide t"
       using ide_char
       by (induct t) auto
 
     lemma elementary_reduction_Raise_iff:
     shows "\<And>d n. elementary_reduction (Raise d n t) \<longleftrightarrow> elementary_reduction t"
       using Ide_Raise
       by (induct t) auto
 
     lemma elementary_reduction_Lam_iff:
     shows "is_Lam t \<Longrightarrow> elementary_reduction t \<longleftrightarrow> elementary_reduction (un_Lam t)"
       by (metis elementary_reduction.simps(3) lambda.collapse(2))
 
     lemma elementary_reduction_App_iff:
     shows "is_App t \<Longrightarrow> elementary_reduction t \<longleftrightarrow>
                         (elementary_reduction (un_App1 t) \<and> ide (un_App2 t)) \<or>
                         (ide (un_App1 t) \<and> elementary_reduction (un_App2 t))"
       using ide_char
       by (metis elementary_reduction.simps(4) lambda.collapse(3))
 
     lemma elementary_reduction_Beta_iff:
     shows "is_Beta t \<Longrightarrow> elementary_reduction t \<longleftrightarrow> ide (un_Beta1 t) \<and> ide (un_Beta2 t)"
       using ide_char
       by (metis elementary_reduction.simps(5) lambda.collapse(4))
 
     lemma cong_elementary_reductions_are_equal:
-    shows "\<And>u. \<lbrakk>elementary_reduction t; elementary_reduction u; t \<sim> u\<rbrakk> \<Longrightarrow> t = u"
-    proof (induct t)
+    shows "\<lbrakk>elementary_reduction t; elementary_reduction u; t \<sim> u\<rbrakk> \<Longrightarrow> t = u"
+    proof (induct t arbitrary: u)
       show "\<And>u. \<lbrakk>elementary_reduction \<^bold>\<sharp>; elementary_reduction u; \<^bold>\<sharp> \<sim> u\<rbrakk> \<Longrightarrow> \<^bold>\<sharp> = u"
         by simp
       show "\<And>x u. \<lbrakk>elementary_reduction \<^bold>\<guillemotleft>x\<^bold>\<guillemotright>; elementary_reduction u; \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<sim> u\<rbrakk> \<Longrightarrow> \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> = u"
         by simp
       show "\<And>t u. \<lbrakk>\<And>u. \<lbrakk>elementary_reduction t; elementary_reduction u; t \<sim> u\<rbrakk> \<Longrightarrow> t = u;
                     elementary_reduction \<^bold>\<lambda>\<^bold>[t\<^bold>]; elementary_reduction u; \<^bold>\<lambda>\<^bold>[t\<^bold>] \<sim> u\<rbrakk>
                      \<Longrightarrow> \<^bold>\<lambda>\<^bold>[t\<^bold>] = u"
         by (metis elementary_reduction_Lam_iff lambda.collapse(2) lambda.inject(2) prfx_Lam_iff)
       show "\<And>t1 t2. \<lbrakk>\<And>u. \<lbrakk>elementary_reduction t1; elementary_reduction u; t1 \<sim> u\<rbrakk> \<Longrightarrow> t1 = u;
                      \<And>u. \<lbrakk>elementary_reduction t2; elementary_reduction u; t2 \<sim> u\<rbrakk> \<Longrightarrow> t2 = u;
                      elementary_reduction (t1 \<^bold>\<circ> t2); elementary_reduction u; t1 \<^bold>\<circ> t2 \<sim> u\<rbrakk>
                        \<Longrightarrow> t1 \<^bold>\<circ> t2 = u"
         for u
         using prfx_App_iff
         apply (cases u)
             apply auto[3]
          apply (metis elementary_reduction_App_iff ide_backward_stable lambda.sel(3-4)
                       weak_extensionality)
         by auto
       show "\<And>t1 t2. \<lbrakk>\<And>u. \<lbrakk>elementary_reduction t1; elementary_reduction u; t1 \<sim> u\<rbrakk> \<Longrightarrow> t1 = u;
                      \<And>u. \<lbrakk>elementary_reduction t2; elementary_reduction u; t2 \<sim> u\<rbrakk> \<Longrightarrow> t2 = u;
                      elementary_reduction (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2); elementary_reduction u; \<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2 \<sim> u\<rbrakk>
                        \<Longrightarrow> \<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2 = u"
         for u
         using prfx_App_iff
         apply (cases u, simp_all)
         by (metis (full_types) Coinitial_iff_Con Ide_iff_Src_self Ide.simps(1))
     qed
 
     text \<open>
       An \emph{elementary reduction path} is a path in which each step is an elementary reduction.
       It will be convenient to regard the empty list as an elementary reduction path, even though
       it is not actually a path according to our previous definition of that notion.
     \<close>
 
     definition (in reduction_paths) elementary_reduction_path
     where "elementary_reduction_path T \<longleftrightarrow>
            (T = [] \<or> Arr T \<and> set T \<subseteq> Collect \<Lambda>.elementary_reduction)"
 
     text \<open>
       In the formal definition of ``development'' given below, we represent a set of
       redexes simply by a term, in which the occurrences of \<open>Beta\<close> correspond to the redexes
       in the set.  To express the idea that an elementary reduction \<open>u\<close> is a member of
       the set of redexes represented by term \<open>t\<close>, it is not adequate to say \<open>u \<lesssim> t\<close>.
       To see this, consider the developments of a term of the form \<open>\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2\<close>. 
       Intuitively, such developments should consist of a (possibly empty) initial segment
       containing only transitions of the form \<open>t1 \<^bold>\<circ> t2\<close>, followed by a transition of the form
       \<open>\<^bold>\<lambda>\<^bold>[u1'\<^bold>] \<^bold>\<Zspot> u2'\<close>, followed by a development of the residual of the original \<open>\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2\<close>
       after what has come so far.
       The requirement \<open>u \<lesssim> \<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2\<close> is not a strong enough constraint on the
       transitions in the initial segment, because \<open>\<^bold>\<lambda>\<^bold>[u1\<^bold>] \<^bold>\<Zspot> u2 \<lesssim> \<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2\<close>
       can hold for \<open>t2\<close> and \<open>u2\<close> coinitial, but otherwise without any particular relationship
       between their sets of marked redexes.  In particular, this can occur when
       \<open>u2\<close> and \<open>t2\<close> occur as subterms that can be deleted by the contraction of an outer redex.
       So we need to introduce a notion of containment between terms that is stronger
       and more ``syntactic'' than \<open>\<lesssim>\<close>.  The notion ``subsumed by'' defined below serves
       this purpose.  Term \<open>u\<close> is subsumed by term \<open>t\<close> if both terms are arrows with exactly
       the same form except that \<open>t\<close> may contain \<open>\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2\<close> (a marked redex) in places
       where \<open>u\<close> contains \<open>\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<circ> t2\<close>.
     \<close>
 
     fun subs  (infix "\<sqsubseteq>" 50)
     where "\<^bold>\<guillemotleft>i\<^bold>\<guillemotright> \<sqsubseteq> \<^bold>\<guillemotleft>i'\<^bold>\<guillemotright> \<longleftrightarrow> i = i'"
         | "\<^bold>\<lambda>\<^bold>[t\<^bold>] \<sqsubseteq> \<^bold>\<lambda>\<^bold>[t'\<^bold>] \<longleftrightarrow> t \<sqsubseteq> t'"
         | "t \<^bold>\<circ> u \<sqsubseteq> t' \<^bold>\<circ> u' \<longleftrightarrow> t \<sqsubseteq> t' \<and> u \<sqsubseteq> u'"
         | "\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<circ> u \<sqsubseteq> \<^bold>\<lambda>\<^bold>[t'\<^bold>] \<^bold>\<Zspot> u' \<longleftrightarrow> t \<sqsubseteq> t' \<and> u \<sqsubseteq> u'"
         | "\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u \<sqsubseteq> \<^bold>\<lambda>\<^bold>[t'\<^bold>] \<^bold>\<Zspot> u' \<longleftrightarrow> t \<sqsubseteq> t' \<and> u \<sqsubseteq> u'"
         | "_ \<sqsubseteq> _ \<longleftrightarrow> False"
 
     lemma subs_implies_prfx:
-    shows "\<And>u. t \<sqsubseteq> u \<Longrightarrow> t \<lesssim> u"
-      apply (induct t)
+    shows "t \<sqsubseteq> u \<Longrightarrow> t \<lesssim> u"
+      apply (induct t arbitrary: u)
           apply auto[1]
       using subs.elims(2)
          apply fastforce
     proof -
       show "\<And>t. \<lbrakk>\<And>u. t \<sqsubseteq> u \<Longrightarrow> t \<lesssim> u; \<^bold>\<lambda>\<^bold>[t\<^bold>] \<sqsubseteq> u\<rbrakk> \<Longrightarrow> \<^bold>\<lambda>\<^bold>[t\<^bold>] \<lesssim> u" for u
         by (cases u, auto) fastforce
       show "\<And>t2. \<lbrakk>\<And>u1. t1 \<sqsubseteq> u1 \<Longrightarrow> t1 \<lesssim> u1;
                   \<And>u2. t2 \<sqsubseteq> u2 \<Longrightarrow> t2 \<lesssim> u2;
                   t1 \<^bold>\<circ> t2 \<sqsubseteq> u\<rbrakk>
                      \<Longrightarrow> t1 \<^bold>\<circ> t2 \<lesssim> u" for t1 u
         apply (cases t1; cases u)
                             apply simp_all
             apply fastforce+
           apply (metis Ide_Subst con_char lambda.sel(2) subs.simps(2) prfx_Lam_iff prfx_char
                        prfx_implies_con)
         by fastforce+
       show "\<And>t1 t2. \<lbrakk>\<And>u1. t1 \<sqsubseteq> u1 \<Longrightarrow> t1 \<lesssim> u1;
                      \<And>u2. t2 \<sqsubseteq> u2 \<Longrightarrow> t2 \<lesssim> u2;
                      \<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2 \<sqsubseteq> u\<rbrakk>
                         \<Longrightarrow> \<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2 \<lesssim> u" for u
         using Ide_Subst
         apply (cases u, simp_all)
         by (metis Ide.simps(1))
     qed
 
     text \<open>
       The following is an example showing that two terms can be related by \<open>\<lesssim>\<close> without being
       related by \<open>\<sqsubseteq>\<close>.
     \<close>
 
     lemma subs_example:
     shows "\<^bold>\<lambda>\<^bold>[\<^bold>\<guillemotleft>1\<^bold>\<guillemotright>\<^bold>] \<^bold>\<Zspot> (\<^bold>\<lambda>\<^bold>[\<^bold>\<guillemotleft>0\<^bold>\<guillemotright>\<^bold>] \<^bold>\<Zspot> \<^bold>\<guillemotleft>0\<^bold>\<guillemotright>) \<lesssim> \<^bold>\<lambda>\<^bold>[\<^bold>\<guillemotleft>1\<^bold>\<guillemotright>\<^bold>] \<^bold>\<Zspot> (\<^bold>\<lambda>\<^bold>[\<^bold>\<guillemotleft>0\<^bold>\<guillemotright>\<^bold>] \<^bold>\<circ> \<^bold>\<guillemotleft>0\<^bold>\<guillemotright>) = True"
     and "\<^bold>\<lambda>\<^bold>[\<^bold>\<guillemotleft>1\<^bold>\<guillemotright>\<^bold>] \<^bold>\<Zspot> (\<^bold>\<lambda>\<^bold>[\<^bold>\<guillemotleft>0\<^bold>\<guillemotright>\<^bold>] \<^bold>\<Zspot> \<^bold>\<guillemotleft>0\<^bold>\<guillemotright>) \<sqsubseteq> \<^bold>\<lambda>\<^bold>[\<^bold>\<guillemotleft>1\<^bold>\<guillemotright>\<^bold>] \<^bold>\<Zspot> (\<^bold>\<lambda>\<^bold>[\<^bold>\<guillemotleft>0\<^bold>\<guillemotright>\<^bold>] \<^bold>\<circ> \<^bold>\<guillemotleft>0\<^bold>\<guillemotright>) = False"
       by auto
 
     lemma subs_Ide:
-    shows "\<And>u. \<lbrakk>ide u; Src t = Src u\<rbrakk> \<Longrightarrow> u \<sqsubseteq> t"
+    shows "\<lbrakk>ide u; Src t = Src u\<rbrakk> \<Longrightarrow> u \<sqsubseteq> t"
       using Ide_Src Ide_implies_Arr Ide_iff_Src_self
-      by (induct t, simp_all) force+
+      by (induct t arbitrary: u, simp_all) force+
 
     lemma subs_App:
     shows "u \<sqsubseteq> t1 \<^bold>\<circ> t2 \<longleftrightarrow> is_App u \<and> un_App1 u \<sqsubseteq> t1 \<and> un_App2 u \<sqsubseteq> t2"
       by (metis lambda.collapse(3) prfx_App_iff subs.simps(3) subs_implies_prfx)
 
   end
 
   context reduction_paths
   begin
 
     text \<open>
       We now formally define a \emph{development of \<open>t\<close>} to be an elementary reduction path \<open>U\<close>
       that is coinitial with \<open>[t]\<close>  and is such that each transition \<open>u\<close> in \<open>U\<close> is subsumed by
       the residual of \<open>t\<close> along the prefix of \<open>U\<close> coming before \<open>u\<close>.  Stated another way,
       each transition in \<open>U\<close> corresponds to the contraction of a single redex that is the residual
       of a redex originally marked in \<open>t\<close>.
     \<close>
 
     fun development
     where "development t [] \<longleftrightarrow> \<Lambda>.Arr t"
         | "development t (u # U) \<longleftrightarrow>
            \<Lambda>.elementary_reduction u \<and> u \<sqsubseteq> t \<and> development (t \\ u) U"
 
     lemma development_imp_Arr:
     assumes "development t U"
     shows "\<Lambda>.Arr t"
       using assms
       by (metis \<Lambda>.Con_implies_Arr2 \<Lambda>.Ide.simps(1) \<Lambda>.ide_char \<Lambda>.subs_implies_prfx
           development.elims(2))
 
     lemma development_Ide:
-    shows "\<And>t. \<Lambda>.Ide t \<Longrightarrow> development t U \<longleftrightarrow> U = []"
+    shows "\<Lambda>.Ide t \<Longrightarrow> development t U \<longleftrightarrow> U = []"
       using \<Lambda>.Ide_implies_Arr
-      apply (induct U)
+      apply (induct U arbitrary: t)
        apply auto
       by (meson \<Lambda>.elementary_reduction_not_ide \<Lambda>.ide_backward_stable \<Lambda>.ide_char
           \<Lambda>.subs_implies_prfx)
 
     lemma development_implies:
-    shows "\<And>t. development t U \<Longrightarrow> elementary_reduction_path U \<and> (U \<noteq> [] \<longrightarrow> U \<^sup>*\<lesssim>\<^sup>* [t])"
-      apply (induct U)
+    shows "development t U \<Longrightarrow> elementary_reduction_path U \<and> (U \<noteq> [] \<longrightarrow> U \<^sup>*\<lesssim>\<^sup>* [t])"
+      apply (induct U arbitrary: t)
       using elementary_reduction_path_def
        apply simp
     proof -
       fix t u U
       assume ind: "\<And>t. development t U \<Longrightarrow>
                        elementary_reduction_path U \<and> (U \<noteq> [] \<longrightarrow> U \<^sup>*\<lesssim>\<^sup>* [t])"
       show "development t (u # U) \<Longrightarrow>
             elementary_reduction_path (u # U) \<and> (u # U \<noteq> [] \<longrightarrow> u # U \<^sup>*\<lesssim>\<^sup>* [t])"
       proof (cases "U = []")
         assume uU: "development t (u # U)"
         show "U = [] \<Longrightarrow> ?thesis"
           using uU \<Lambda>.subs_implies_prfx ide_char \<Lambda>.elementary_reduction_is_arr
                 elementary_reduction_path_def prfx_implies_con
           by force
         assume U: "U \<noteq> []"
         have "\<Lambda>.elementary_reduction u \<and> u \<sqsubseteq> t \<and> development (t \\ u) U"
           using U uU development.elims(1) by blast
         hence 1: "\<Lambda>.elementary_reduction u \<and> elementary_reduction_path U \<and> u \<sqsubseteq> t \<and>
                   (U \<noteq> [] \<longrightarrow> U \<^sup>*\<lesssim>\<^sup>* [t \\ u])"
           using U uU ind by auto
         show ?thesis
         proof (unfold elementary_reduction_path_def, intro conjI)
           show "u # U = [] \<or> Arr (u # U) \<and> set (u # U) \<subseteq> Collect \<Lambda>.elementary_reduction"
             using U 1
             by (metis Con_implies_Arr(1) Con_rec(2) con_char prfx_implies_con
                 elementary_reduction_path_def insert_subset list.simps(15) mem_Collect_eq
                 \<Lambda>.prfx_implies_con \<Lambda>.subs_implies_prfx)
           show "u # U \<noteq> [] \<longrightarrow> u # U \<^sup>*\<lesssim>\<^sup>* [t]"
           proof -
             have "u # U \<^sup>*\<lesssim>\<^sup>* [t] \<longleftrightarrow> ide ([u \\ t] @ U \<^sup>*\\\<^sup>* [t \\ u])"
               using 1 U Con_rec(2) Resid_rec(2) con_char prfx_implies_con
                     \<Lambda>.prfx_implies_con \<Lambda>.subs_implies_prfx
               by simp
             also have "... \<longleftrightarrow> True"
               using U 1 ide_char Ide_append_iff\<^sub>P\<^sub>W\<^sub>E [of "[u \\ t]" "U \<^sup>*\\\<^sup>* [t \\ u]"]
               by (metis Ide.simps(2) Ide_appendI\<^sub>P\<^sub>W\<^sub>E Src_resid Trg.simps(2) \<Lambda>.prfx_implies_con
                   \<Lambda>.trg_resid_sym con_char \<Lambda>.subs_implies_prfx prfx_implies_con)
             finally show ?thesis by blast
           qed
         qed
       qed
     qed
 
     text \<open>
       The converse of the previous result does not hold, because there could be a stage \<open>i\<close>
       at which \<open>u\<^sub>i \<lesssim> t\<^sub>i\<close>, but \<open>t\<^sub>i\<close>  deletes the redex contracted in \<open>u\<^sub>i\<close>, so there is nothing
       forcing that redex to have been originally marked in \<open>t\<close>.  So \<open>U\<close> being a development
       of \<open>t\<close> is a stronger property than \<open>U\<close> just being an elementary reduction path such
       that \<open>U \<^sup>*\<lesssim>\<^sup>* [t]\<close>.
     \<close>
 
     lemma development_append:
-    shows "\<And>t V. \<lbrakk>development t U; development (t \<^sup>1\\\<^sup>* U) V\<rbrakk> \<Longrightarrow> development t (U @ V)"
+    shows "\<lbrakk>development t U; development (t \<^sup>1\\\<^sup>* U) V\<rbrakk> \<Longrightarrow> development t (U @ V)"
       using development_imp_Arr null_char
-      apply (induct U)
+      apply (induct U arbitrary: t V)
        apply auto
       by (metis Resid1x.simps(2-3) append_Nil neq_Nil_conv)
 
     lemma development_map_Lam:
-    shows "\<And>t. development t T \<Longrightarrow> development \<^bold>\<lambda>\<^bold>[t\<^bold>] (map \<Lambda>.Lam T)"
+    shows "development t T \<Longrightarrow> development \<^bold>\<lambda>\<^bold>[t\<^bold>] (map \<Lambda>.Lam T)"
       using \<Lambda>.Arr_not_Nil development_imp_Arr
-      by (induct T) auto
+      by (induct T arbitrary: t) auto
 
     lemma development_map_App_1:
-    shows "\<And>t. \<lbrakk>development t T; \<Lambda>.Arr u\<rbrakk>
-                  \<Longrightarrow> development (t \<^bold>\<circ> u) (map (\<lambda>x. x \<^bold>\<circ> \<Lambda>.Src u) T)"
-      apply (induct T)
+    shows "\<lbrakk>development t T; \<Lambda>.Arr u\<rbrakk> \<Longrightarrow> development (t \<^bold>\<circ> u) (map (\<lambda>x. x \<^bold>\<circ> \<Lambda>.Src u) T)"
+      apply (induct T arbitrary: t)
        apply (simp add: \<Lambda>.Ide_implies_Arr)
     proof -
       fix t T t'
       assume ind: "\<And>t. \<lbrakk>development t T; \<Lambda>.Arr u\<rbrakk>
                           \<Longrightarrow> development (t \<^bold>\<circ> u) (map (\<lambda>x. x \<^bold>\<circ> \<Lambda>.Src u) T)"
       assume t'T: "development t (t' # T)"
       assume u: "\<Lambda>.Arr u"
       show "development (t \<^bold>\<circ> u) (map (\<lambda>x. x \<^bold>\<circ> \<Lambda>.Src u) (t' # T))"
         using u t'T ind
         apply simp
         using \<Lambda>.Arr_not_Nil \<Lambda>.Ide_Src development_imp_Arr \<Lambda>.subs_Ide by force
     qed
 
     lemma development_map_App_2:
-    shows "\<And>u. \<lbrakk>\<Lambda>.Arr t; development u U\<rbrakk>
-                  \<Longrightarrow> development (t \<^bold>\<circ> u) (map (\<lambda>x. \<Lambda>.App (\<Lambda>.Src t) x) U)"
-      apply (induct U)
+    shows "\<lbrakk>\<Lambda>.Arr t; development u U\<rbrakk> \<Longrightarrow> development (t \<^bold>\<circ> u) (map (\<lambda>x. \<Lambda>.App (\<Lambda>.Src t) x) U)"
+      apply (induct U arbitrary: u)
        apply (simp add: \<Lambda>.Ide_implies_Arr)
     proof -
       fix u U u'
       assume ind: "\<And>u. \<lbrakk>\<Lambda>.Arr t; development u U\<rbrakk>
                           \<Longrightarrow> development (t \<^bold>\<circ> u) (map (\<Lambda>.App (\<Lambda>.Src t)) U)"
       assume u'U: "development u (u' # U)"
       assume t: "\<Lambda>.Arr t"
       show "development (t \<^bold>\<circ> u) (map (\<Lambda>.App (\<Lambda>.Src t)) (u' # U)) "
         using t u'U ind
         apply simp
         by (metis \<Lambda>.Coinitial_iff_Con \<Lambda>.Ide_Src \<Lambda>.Ide_iff_Src_self \<Lambda>.Ide_implies_Arr
             development_imp_Arr \<Lambda>.ide_char \<Lambda>.resid_Arr_Ide \<Lambda>.subs_Ide)
     qed
 
     subsection "Finiteness of Developments"
 
     text \<open>
       A term \<open>t\<close> has the finite developments property if there exists a finite value
       that bounds the length of all developments of \<open>t\<close>.  The goal of this section is
       to prove the Finite Developments Theorem: every term has the finite developments
       property.
     \<close>
 
     definition FD
     where "FD t \<equiv> \<exists>n. \<forall>U. development t U \<longrightarrow> length U \<le> n"
 
   end
 
   text \<open>
     In \cite{hindley}, Hindley proceeds by using structural induction to establish
     a bound on the length of a development of a term.
     The only case that poses any difficulty is the case of a \<open>\<beta>\<close>-redex, which is
     \<open>\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u\<close> in the notation used here.  He notes that there is an easy bound on the
     length of a development of a special form in which all the contractions of residuals of \<open>t\<close>
     occur before the contraction of the top-level redex.  The development first
     takes \<open>\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u\<close> to \<open>\<^bold>\<lambda>\<^bold>[t'\<^bold>] \<^bold>\<Zspot> u'\<close>, then to \<open>subst u' t'\<close>, then continues with
     independent developments of \<open>u'\<close>.  The number of independent developments of \<open>u'\<close>
     is given by the number of free occurrences of \<open>Var 0\<close> in \<open>t'\<close>.  As there can be
     only finitely many such \<open>t'\<close>, we can use the maximum number of free occurrences
     of \<open>Var 0\<close> over all such \<open>t'\<close> to bound the steps in the independent developments of \<open>u'\<close>.
 
     In the general case, the problem is that reductions of residuals of t can
     increase the number of free occurrences of \<open>Var 0\<close>, so we can't readily count
     them at any particular stage.  Hindley shows that developments in which
     there are reductions of residuals of \<open>t\<close> that occur after the contraction of the
     top-level redex are equivalent to reductions of the special form, by a
     transformation with a bounded increase in length.  This can be considered as a
     weak form of standardization for developments.
 
     A later paper by de Vrijer \cite{deVrijer} obtains an explicit function for the
     exact number of steps in a development of maximal length.  His proof is very
     straightforward and amenable to formalization, and it is what we follow here.
     The main issue for us is that de Vrijer uses a classical representation of \<open>\<lambda>\<close>-terms,
     with variable names and \<open>\<alpha>\<close>-equivalence, whereas here we are using de Bruijn indices.
     This means that we have to discover the correct modification of de Vrijer's definitions
     to apply to the present situation.
   \<close>
 
   context lambda_calculus
   begin
 
     text \<open>
       Our first definition is that of the ``multiplicity'' of a free variable in a term.
       This is a count of the maximum number of times a variable could occur free in a term
       reachable in a development.  The main issue in adjusting to de Bruijn indices
       is that the same variable will have different indices depending on the depth at which
       it occurs in the term.  So, we need to keep track of how the indices of variables change
       as we move through the term.  Our modified definitions adjust the parameter to the
       multiplicity function on each recursive call, to account for the contextual depth
       (\emph{i.e.}~the number of binders on a path from the root of the term).
      
       The definition of this function is readily understandable, except perhaps for the
       \<open>Beta\<close> case.  The multiplicity \<open>mtp x (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u)\<close> has to be at least as large as
       \<open>mtp x (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<circ> u)\<close>, to account for developments in which the top-level redex is not
       contracted.  However, if the top-level redex \<open>\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u\<close> is contracted, then the contractum
       is \<open>subst u t\<close>, so the multiplicity has to be at least as large as \<open>mtp x (subst u t)\<close>.
       This leads to the relation:
       \begin{center}
         \<open>mtp x (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) = max (mtp x (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<circ> u)) (mtp x (subst u t))\<close>
       \end{center}
       This is not directly suitable for use in a definition of the function \<open>mtp\<close>, because
       proving the termination is problematic.  Instead, we have to guess the correct
       expression for \<open>mtp x (subst u t)\<close> and use that.
     
       Now, each variable \<open>x\<close> in \<open>subst u t\<close> other than the variable \<open>0\<close> that is substituted for
       still has all the occurrences that it does in \<open>\<^bold>\<lambda>\<^bold>[t\<^bold>]\<close>.  In addition, the variable being
       substituted for (which has index \<open>0\<close> in the outermost context of \<open>t\<close>) will in general have
       multiple free occurrences in \<open>t\<close>, with a total multiplicity given by \<open>mtp 0 t\<close>.
       The substitution operation replaces each free occurrence by \<open>u\<close>, which has the effect of
       multiplying the multiplicity of a variable \<open>x\<close> in \<open>t\<close> by a factor of \<open>mtp 0 t\<close>.
       These considerations lead to the following:
       \begin{center}
        \<open>mtp x (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) = max (mtp x \<^bold>\<lambda>\<^bold>[t\<^bold>] + mtp x u) (mtp x \<^bold>\<lambda>\<^bold>[t\<^bold>] + mtp x u * mtp 0 t)\<close>
       \end{center}
       However, we can simplify this to:
       \begin{center}
        \<open>mtp x (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) = mtp x \<^bold>\<lambda>\<^bold>[t\<^bold>] + mtp x u * max 1 (mtp 0 t)\<close>
       \end{center}
       and replace the \<open>mtp x \<^bold>\<lambda>\<^bold>[t\<^bold>]\<close> by \<open>mtp (Suc x) t\<close> to simplify the ordering necessary
       for the termination proof and allow it to be done automatically.
      
       The final result is perhaps about the first thing one would think to write down,
       but there are possible ways to go wrong and it is of course still necessary to discover
       the proper form required for the various induction proofs.  I followed a long path
       of rather more complicated-looking definitions, until I eventually managed to find the
       proper inductive forms for all the lemmas and eventually arrive back at this definition.
     \<close>
 
     fun mtp :: "nat \<Rightarrow> lambda \<Rightarrow> nat"
     where "mtp x \<^bold>\<sharp> = 0"
         | "mtp x \<^bold>\<guillemotleft>z\<^bold>\<guillemotright> = (if z = x then 1 else 0)"
         | "mtp x \<^bold>\<lambda>\<^bold>[t\<^bold>] = mtp (Suc x) t"
         | "mtp x (t \<^bold>\<circ> u) = mtp x t + mtp x u"
         | "mtp x (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) = mtp (Suc x) t + mtp x u * max 1 (mtp 0 t)"
 
     text \<open>
       The multiplicity function generalizes the free variable predicate.
       This is not actually used, but is included for explanatory purposes.
     \<close>
 
     lemma mtp_gt_0_iff_in_FV:
-    shows "\<And>x. mtp x t > 0 \<longleftrightarrow> x \<in> FV t"
-    proof (induct t)
+    shows "mtp x t > 0 \<longleftrightarrow> x \<in> FV t"
+    proof (induct t arbitrary: x)
       show "\<And>x. 0 < mtp x \<^bold>\<sharp> \<longleftrightarrow> x \<in> FV \<^bold>\<sharp>"
         by simp
       show "\<And>x z. 0 < mtp x \<^bold>\<guillemotleft>z\<^bold>\<guillemotright> \<longleftrightarrow> x \<in> FV \<^bold>\<guillemotleft>z\<^bold>\<guillemotright>"
         by auto
       show Lam: "\<And>t x. (\<And>x. 0 < mtp x t \<longleftrightarrow> x \<in> FV t)
                           \<Longrightarrow> 0 < mtp x \<^bold>\<lambda>\<^bold>[t\<^bold>] \<longleftrightarrow> x \<in> FV \<^bold>\<lambda>\<^bold>[t\<^bold>]"
       proof -
         fix t and x :: nat
         assume ind: "\<And>x. 0 < mtp x t \<longleftrightarrow> x \<in> FV t"
         show "0 < mtp x \<^bold>\<lambda>\<^bold>[t\<^bold>] \<longleftrightarrow> x \<in> FV \<^bold>\<lambda>\<^bold>[t\<^bold>]"
           using ind
           apply auto
           apply (metis Diff_iff One_nat_def diff_Suc_1 empty_iff imageI insert_iff
                        nat.distinct(1))
           by (metis Suc_pred neq0_conv)
       qed
       show "\<And>t u x.
               \<lbrakk>\<And>x. 0 < mtp x t \<longleftrightarrow> x \<in> FV t;
                \<And>x. 0 < mtp x u \<longleftrightarrow> x \<in> FV u\<rbrakk>
                  \<Longrightarrow> 0 < mtp x (t \<^bold>\<circ> u) \<longleftrightarrow> x \<in> FV (t \<^bold>\<circ> u)"
         by simp
       show "\<And>t u x.
               \<lbrakk>\<And>x. 0 < mtp x t \<longleftrightarrow> x \<in> FV t;
                \<And>x. 0 < mtp x u \<longleftrightarrow> x \<in> FV u\<rbrakk>
                  \<Longrightarrow> 0 < mtp x (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) \<longleftrightarrow> x \<in> FV (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u)"
       proof -
         fix t u and x :: nat
         assume ind1: "\<And>x. 0 < mtp x t \<longleftrightarrow> x \<in> FV t"
         assume ind2: "\<And>x. 0 < mtp x u \<longleftrightarrow> x \<in> FV u"
         show "0 < mtp x (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) \<longleftrightarrow> x \<in> FV (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u)"
           using ind1 ind2
           apply simp
           by force
       qed
     qed
 
     text \<open>
       We now establish a fact about commutation of multiplicity and Raise that will be
       needed subsequently.
     \<close>
 
     lemma mtpE_eq_Raise:
-    shows "\<And>x k d. x < d \<Longrightarrow> mtp x (Raise d k t) = mtp x t"
-      by (induct t) auto
+    shows "x < d \<Longrightarrow> mtp x (Raise d k t) = mtp x t"
+      by (induct t arbitrary: x k d) auto
 
     lemma mtp_Raise_ind:
-    shows "\<And>d x k l t. \<lbrakk>l \<le> d; size t \<le> s\<rbrakk> \<Longrightarrow> mtp (x + d + k) (Raise l k t) = mtp (x + d) t"
-    proof (induct s)
+    shows "\<lbrakk>l \<le> d; size t \<le> s\<rbrakk> \<Longrightarrow> mtp (x + d + k) (Raise l k t) = mtp (x + d) t"
+    proof (induct s arbitrary: d x k l t)
       show "\<And>d x k l. \<lbrakk>l \<le> d; size t \<le> 0\<rbrakk> \<Longrightarrow> mtp (x + d + k) (Raise l k t) = mtp (x + d) t"
               for t
         by (cases t) auto
       show "\<And>s d x k l.
                \<lbrakk>\<And>d x k l t. \<lbrakk>l \<le> d; size t \<le> s\<rbrakk> \<Longrightarrow> mtp (x + d + k) (Raise l k t) = mtp (x + d) t;
                 l \<le> d; size t \<le> Suc s\<rbrakk>
                   \<Longrightarrow> mtp (x + d + k) (Raise l k t) = mtp (x + d) t"
         for t
       proof (cases t)
         show "\<And>d x k l s. t = \<^bold>\<sharp> \<Longrightarrow> mtp (x + d + k) (Raise l k t) = mtp (x + d) t"
           by simp
         show "\<And>z d x k l s. \<lbrakk>l \<le> d; t = \<^bold>\<guillemotleft>z\<^bold>\<guillemotright>\<rbrakk>
                                \<Longrightarrow> mtp (x + d + k) (Raise l k t) = mtp (x + d) t"
           by simp
         show "\<And>u d x k l s. \<lbrakk>l \<le> d; size t \<le> Suc s; t = \<^bold>\<lambda>\<^bold>[u\<^bold>];
                              (\<And>d x k l u. \<lbrakk>l \<le> d; size u \<le> s\<rbrakk>
                                              \<Longrightarrow> mtp (x + d + k) (Raise l k u) = mtp (x + d) u)\<rbrakk>
                                \<Longrightarrow> mtp (x + d + k) (Raise l k t) = mtp (x + d) t"
         proof -
           fix u d x s and k l :: nat
           assume l: "l \<le> d" and s: "size t \<le> Suc s" and t: "t = \<^bold>\<lambda>\<^bold>[u\<^bold>]"
           assume ind: "\<And>d x k l u. \<lbrakk>l \<le> d; size u \<le> s\<rbrakk>
                                        \<Longrightarrow> mtp (x + d + k) (Raise l k u) = mtp (x + d) u"
           show "mtp (x + d + k) (Raise l k t) = mtp (x + d) t"
           proof -
             have "mtp (x + d + k) (Raise l k t) = mtp (Suc (x + d + k)) (Raise (Suc l) k u)"
               using t by simp
             also have "... = mtp (x + Suc d) u"
             proof -
               have "size u \<le> s"
                 using t s by force
               thus ?thesis
                 using l s ind [of "Suc l" "Suc d"] by simp
             qed
             also have "... = mtp (x + d) t"
               using t by auto
             finally show ?thesis by blast
           qed
         qed
         show "\<And>t1 t2 d x k l s.
                 \<lbrakk>\<And>d x k l t1. \<lbrakk>l \<le> d; size t1 \<le> s\<rbrakk>
                                  \<Longrightarrow> mtp (x + d + k) (Raise l k t1) = mtp (x + d) t1;
                  \<And>d x k l t2. \<lbrakk>l \<le> d; size t2 \<le> s\<rbrakk>
                                  \<Longrightarrow> mtp (x + d + k) (Raise l k t2) = mtp (x + d) t2;
                  l \<le> d; size t \<le> Suc s; t = t1 \<^bold>\<circ> t2\<rbrakk>
                     \<Longrightarrow> mtp (x + d + k) (Raise l k t) = mtp (x + d) t"
         proof -
           fix t1 t2 s
           assume s: "size t \<le> Suc s" and t: "t = t1 \<^bold>\<circ> t2"
           have "size t1 \<le> s \<and> size t2 \<le> s"
             using s t by auto
           thus "\<And>d x k l.
                   \<lbrakk>\<And>d x k l t1. \<lbrakk>l \<le> d; size t1 \<le> s\<rbrakk>
                                    \<Longrightarrow> mtp (x + d + k) (Raise l k t1) = mtp (x + d) t1;
                    \<And>d x k l t2. \<lbrakk>l \<le> d; size t2 \<le> s\<rbrakk>
                                    \<Longrightarrow> mtp (x + d + k) (Raise l k t2) = mtp (x + d) t2;
                    l \<le> d; size t \<le> Suc s; t = t1 \<^bold>\<circ> t2\<rbrakk>
                       \<Longrightarrow> mtp (x + d + k) (Raise l k t) = mtp (x + d) t"
             by simp
         qed
         show "\<And>t1 t2 d x k l s.
                  \<lbrakk>\<And>d x k l t1. \<lbrakk>l \<le> d; size t1 \<le> s\<rbrakk>
                                   \<Longrightarrow> mtp (x + d + k) (Raise l k t1) = mtp (x + d) t1;
                   \<And>d x k l t2. \<lbrakk>l \<le> d; size t2 \<le> s\<rbrakk>
                                   \<Longrightarrow> mtp (x + d + k) (Raise l k t2) = mtp (x + d) t2;
                   l \<le> d; size t \<le> Suc s; t = \<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2\<rbrakk>
                      \<Longrightarrow> mtp (x + d + k) (Raise l k t) = mtp (x + d) t"
         proof -
           fix t1 t2 d x s and k l :: nat
           assume l: "l \<le> d" and s: "size t \<le> Suc s" and t: "t = \<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2"
           assume ind: "\<And>d x k l N. \<lbrakk>l \<le> d; size N \<le> s\<rbrakk>
                                       \<Longrightarrow> mtp (x + d + k) (Raise l k N) = mtp (x + d) N"
           show "mtp (x + d + k) (Raise l k t) = mtp (x + d) t"
           proof -
             have 1: "size t1 \<le> s \<and> size t2 \<le> s"
               using s t by auto
             have "mtp (x + d + k) (Raise l k t) =
                   mtp (Suc (x + d + k)) (Raise (Suc l) k t1) +
                     mtp (x + d + k) (Raise l k t2) * max 1 (mtp 0 (Raise (Suc l) k t1))"
               using t l by simp
             also have "... = mtp (Suc (x + d + k)) (Raise (Suc l) k t1) +
                              mtp (x + d) t2 * max 1 (mtp 0 (Raise (Suc l) k t1))"
               using l 1 ind by auto
             also have "... = mtp (x + Suc d) t1 + mtp (x + d) t2 * max 1 (mtp 0 t1)"
             proof -
               have "mtp (x + Suc d + k) (Raise (Suc l) k t1) = mtp (x + Suc d) t1"
                 using l 1 ind [of "Suc l" "Suc d" t1] by simp
               moreover have "mtp 0 (Raise (Suc l) k t1) = mtp 0 t1"
                 (* Raising indices already > 0 does not affect mtp\<^sub>0. *)
                 using l 1 ind [of "Suc l" "Suc d" t1 k] mtpE_eq_Raise by simp
               ultimately show ?thesis
                 by simp
             qed
             also have "... = mtp (x + d) t"
               using t by auto
             finally show ?thesis by blast
           qed
         qed
       qed
     qed
 
     lemma mtp_Raise:
     assumes "l \<le> d"
     shows "mtp (x + d + k) (Raise l k t) = mtp (x + d) t"
       using assms mtp_Raise_ind by blast
 
     lemma mtp_Raise':
-    shows "\<And>k l. mtp l (Raise l (Suc k) t) = 0"
-      by (induct t) auto
+    shows "mtp l (Raise l (Suc k) t) = 0"
+      by (induct t arbitrary: k l) auto
 
     lemma mtp_raise:
     shows "mtp (x + Suc d) (raise d t) = mtp (Suc x) t"
        by (metis Suc_eq_plus1 add.assoc le_add2 le_add_same_cancel2 mtp_Raise plus_1_eq_Suc)
 
     lemma mtp_Subst_cancel:
-    shows "\<And>k d n. mtp k (Subst (Suc d + k) u t) = mtp k t"
-    proof (induct t)
-      show "\<And>k d n. mtp k (Subst (Suc d + k) u \<^bold>\<sharp>) = mtp k \<^bold>\<sharp>"
+    shows "mtp k (Subst (Suc d + k) u t) = mtp k t"
+    proof (induct t arbitrary: k d)
+      show "\<And>k d. mtp k (Subst (Suc d + k) u \<^bold>\<sharp>) = mtp k \<^bold>\<sharp>"
         by simp
-      show "\<And>k z d n. mtp k (Subst (Suc d + k) u \<^bold>\<guillemotleft>z\<^bold>\<guillemotright>) = mtp k \<^bold>\<guillemotleft>z\<^bold>\<guillemotright>"
+      show "\<And>k z d. mtp k (Subst (Suc d + k) u \<^bold>\<guillemotleft>z\<^bold>\<guillemotright>) = mtp k \<^bold>\<guillemotleft>z\<^bold>\<guillemotright>"
       using mtp_Raise'
         apply auto
         by (metis add_Suc_right add_Suc_shift order_refl raise_plus)
-      show "\<And>t k d n. (\<And>k d n. mtp k (Subst (Suc d + k) u t) = mtp k t)
+      show "\<And>t k d. (\<And>k d. mtp k (Subst (Suc d + k) u t) = mtp k t)
                         \<Longrightarrow> mtp k (Subst (Suc d + k) u \<^bold>\<lambda>\<^bold>[t\<^bold>]) = mtp k \<^bold>\<lambda>\<^bold>[t\<^bold>]"
         by (metis Subst.simps(3) add_Suc_right mtp.simps(3))
-      show "\<And>t1 t2 k d n.
-               \<lbrakk>\<And>k d n. mtp k (Subst (Suc d + k) u t1) = mtp k t1;
-                \<And>k d n. mtp k (Subst (Suc d + k) u t2) = mtp k t2\<rbrakk>
+      show "\<And>t1 t2 k d.
+               \<lbrakk>\<And>k d. mtp k (Subst (Suc d + k) u t1) = mtp k t1;
+                \<And>k d. mtp k (Subst (Suc d + k) u t2) = mtp k t2\<rbrakk>
                    \<Longrightarrow> mtp k (Subst (Suc d + k) u (t1 \<^bold>\<circ> t2)) = mtp k (t1 \<^bold>\<circ> t2)"
         by auto
-      show "\<And>t1 t2 k d n.
-         \<lbrakk>\<And>k d n. mtp k (Subst (Suc d + k) u t1) = mtp k t1;
-          \<And>k d n. mtp k (Subst (Suc d + k) u t2) = mtp k t2\<rbrakk>
+      show "\<And>t1 t2 k d.
+         \<lbrakk>\<And>k d. mtp k (Subst (Suc d + k) u t1) = mtp k t1;
+          \<And>k d. mtp k (Subst (Suc d + k) u t2) = mtp k t2\<rbrakk>
              \<Longrightarrow> mtp k (Subst (Suc d + k) u (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)) = mtp k (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)"
         using mtp_Raise'
         apply auto
         by (metis Nat.add_0_right add_Suc_right)
     qed
 
     lemma mtp\<^sub>0_Subst_cancel:
     shows "mtp 0 (Subst (Suc d) u t) = mtp 0 t"
       using mtp_Subst_cancel [of 0] by simp
 
     text \<open>
       We can now (!) prove the desired generalization of de Vrijer's formula for the
       commutation of multiplicity and substitution.  This is the main lemma whose form
       is difficult to find.  To get this right, the proper relationships have to exist
       between the various depth parameters to \<open>Subst\<close> and the arguments to \<open>mtp\<close>.
     \<close>
 
     lemma mtp_Subst':
-    shows "\<And>d x u. mtp (x + Suc d) (Subst d u t) =
-                    mtp (x + Suc (Suc d)) t + mtp (Suc x) u * mtp d t"
-    proof (induct t)
+    shows "mtp (x + Suc d) (Subst d u t) = mtp (x + Suc (Suc d)) t + mtp (Suc x) u * mtp d t"
+    proof (induct t arbitrary: d x u)
       show "\<And>d x u. mtp (x + Suc d) (Subst d u \<^bold>\<sharp>) =
             mtp (x + Suc (Suc d)) \<^bold>\<sharp> + mtp (Suc x) u * mtp d \<^bold>\<sharp>"
         by simp
       show "\<And>z d x u. mtp (x + Suc d) (Subst d u \<^bold>\<guillemotleft>z\<^bold>\<guillemotright>) =
                        mtp (x + Suc (Suc d)) \<^bold>\<guillemotleft>z\<^bold>\<guillemotright> + mtp (Suc x) u * mtp d \<^bold>\<guillemotleft>z\<^bold>\<guillemotright>"
         using mtp_raise by auto
       show "\<And>t d x u.
               (\<And>d x u. mtp (x + Suc d) (Subst d u t) =
                         mtp (x + Suc (Suc d)) t + mtp (Suc x) u * mtp d t)
                           \<Longrightarrow> mtp (x + Suc d) (Subst d u \<^bold>\<lambda>\<^bold>[t\<^bold>]) =
                               mtp (x + Suc (Suc d)) \<^bold>\<lambda>\<^bold>[t\<^bold>] + mtp (Suc x) u * mtp d \<^bold>\<lambda>\<^bold>[t\<^bold>]"
       proof -
         fix t u d x
         assume ind: "\<And>d x N. mtp (x + Suc d) (Subst d N t) =
                               mtp (x + Suc (Suc d)) t + mtp (Suc x) N * mtp d t"
         have "mtp (x + Suc d) (Subst d u \<^bold>\<lambda>\<^bold>[t\<^bold>]) =
               mtp (Suc x + Suc (Suc d)) t +
               mtp (x + Suc (Suc d)) (raise (Suc d) u) * mtp (Suc d) t"
           using ind mtp_raise add_Suc_shift
           by (metis Subst.simps(3) add_Suc_right mtp.simps(3))
         also have "... = mtp (x + Suc (Suc d)) \<^bold>\<lambda>\<^bold>[t\<^bold>] + mtp (Suc x) u * mtp d \<^bold>\<lambda>\<^bold>[t\<^bold>]"
           using Raise_Suc
           by (metis add_Suc_right add_Suc_shift mtp.simps(3) mtp_raise)
         finally show "mtp (x + Suc d) (Subst d u \<^bold>\<lambda>\<^bold>[t\<^bold>]) =
                       mtp (x + Suc (Suc d)) \<^bold>\<lambda>\<^bold>[t\<^bold>] + mtp (Suc x) u * mtp d \<^bold>\<lambda>\<^bold>[t\<^bold>]"
           by blast
       qed
       show "\<And>t1 t2 u d x.
                \<lbrakk>\<And>d x u. mtp (x + Suc d) (Subst d u t1) =
                         mtp (x + Suc (Suc d)) t1 + mtp (Suc x) u * mtp d t1;
                 \<And>d x u. mtp (x + Suc d) (Subst d u t2) =
                          mtp (x + Suc (Suc d)) t2 + mtp (Suc x) u * mtp d t2\<rbrakk>
                   \<Longrightarrow> mtp (x + Suc d) (Subst d u (t1 \<^bold>\<circ> t2)) =
                       mtp (x + Suc (Suc d)) (t1 \<^bold>\<circ> t2) + mtp (Suc x) u * mtp d (t1 \<^bold>\<circ> t2)"
         by (simp add: add_mult_distrib2)
       show "\<And>t1 t2 u d x.
               \<lbrakk>\<And>d x N. mtp (x + Suc d) (Subst d N t1) =
                        mtp (x + Suc (Suc d)) t1 + mtp (Suc x) N * mtp d t1;
               \<And>d x N. mtp (x + Suc d) (Subst d N t2) =
                        mtp (x + Suc (Suc d)) t2 + mtp (Suc x) N * mtp d t2\<rbrakk>
                  \<Longrightarrow> mtp (x + Suc d) (Subst d u (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)) =
                      mtp (x + Suc (Suc d)) (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) + mtp (Suc x) u * mtp d (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)"
       proof -
         fix t1 t2 u d x
         assume ind1: "\<And>d x N. mtp (x + Suc d) (Subst d N t1) =
                                mtp (x + Suc (Suc d)) t1 + mtp (Suc x) N * mtp d t1"
         assume ind2: "\<And>d x N. mtp (x + Suc d) (Subst d N t2) =
                                mtp (x + Suc (Suc d)) t2 + mtp (Suc x) N * mtp d t2"
         show "mtp (x + Suc d) (Subst d u (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)) =
               mtp (x + Suc (Suc d)) (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) + mtp (Suc x) u * mtp d (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)"
         proof -
           let ?A = "mtp (Suc x + Suc (Suc d)) t1"
           let ?B = "mtp (Suc x + Suc d) t2"
           let ?M1 = "mtp (Suc d) t1"
           let ?M2 = "mtp d t2"
           let ?M1\<^sub>0 = "mtp 0 (Subst (Suc d) u t1)"
           let ?M1\<^sub>0' = "mtp 0 t1"
           let ?N = "mtp (Suc x) u"
           have "mtp (x + Suc d) (Subst d u (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)) =
                 mtp (x + Suc d) (\<^bold>\<lambda>\<^bold>[Subst (Suc d) u t1\<^bold>] \<^bold>\<Zspot> Subst d u t2)"
              by simp
           also have "... = mtp (x + Suc (Suc d)) (Subst (Suc d) u t1) +
                            mtp (x + Suc d) (Subst d u t2) *
                              max 1 (mtp 0 (Subst (Suc d) u t1))"
             by simp
           also have "... = (?A + ?N * ?M1) + (?B + ?N * ?M2) * max 1 ?M1\<^sub>0"
             using ind1 ind2 add_Suc_shift by presburger
           also have "... = ?A + ?N * ?M1 + ?B * max 1 ?M1\<^sub>0 + ?N * ?M2 * max 1 ?M1\<^sub>0"
             by algebra
           also have "... = ?A + ?B * max 1 ?M1\<^sub>0' + ?N * ?M1 + ?N * ?M2 * max 1 ?M1\<^sub>0'"
           proof -
             have "?M1\<^sub>0 = ?M1\<^sub>0'"
             (* The u-dependence on the LHS is via raise (Suc d) u, which does not have
                any free occurrences of 0.  So mtp 0 0 yields the same on both. *)
               using mtp\<^sub>0_Subst_cancel by blast
             thus ?thesis by auto
           qed
           also have "... = ?A + ?B * max 1 ?M1\<^sub>0' + ?N * (?M1 + ?M2 * max 1 ?M1\<^sub>0')"
             by algebra
           also have "... =  mtp (Suc x + Suc d) (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) + mtp (Suc x) u * mtp d (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)"
             by simp
           finally show ?thesis by simp
         qed
       qed
     qed
 
     text \<open>
       The following lemma provides expansions that apply when the parameter to \<open>mtp\<close> is \<open>0\<close>,
       as opposed to the previous lemma, which only applies for parameters greater than \<open>0\<close>.
     \<close>
 
     lemma mtp_Subst:
-    shows "\<And>u k. mtp k (Subst k u t) = mtp (Suc k) t + mtp k (raise k u) * mtp k t"
-    proof (induct t)
+    shows "mtp k (Subst k u t) = mtp (Suc k) t + mtp k (raise k u) * mtp k t"
+    proof (induct t arbitrary: u k)
       show "\<And>u k. mtp k (Subst k u \<^bold>\<sharp>) = mtp (Suc k) \<^bold>\<sharp> + mtp k (raise k u) * mtp k \<^bold>\<sharp>"
         by simp
       show "\<And>x u k. mtp k (Subst k u \<^bold>\<guillemotleft>x\<^bold>\<guillemotright>) =
                      mtp (Suc k) \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> + mtp k (raise k u) * mtp k \<^bold>\<guillemotleft>x\<^bold>\<guillemotright>"
         by auto
       show "\<And>t u k. (\<And>u k. mtp k (Subst k u t) = mtp (Suc k) t + mtp k (raise k u) * mtp k t)
                               \<Longrightarrow> mtp k (Subst k u \<^bold>\<lambda>\<^bold>[t\<^bold>]) =
                                   mtp (Suc k) \<^bold>\<lambda>\<^bold>[t\<^bold>] + mtp k (Raise 0 k u) * mtp k \<^bold>\<lambda>\<^bold>[t\<^bold>]"
         using mtp_Raise [of 0]
         apply auto
         by (metis add.left_neutral)
       show "\<And>t1 t2 u k.
               \<lbrakk>\<And>u k. mtp k (Subst k u t1) = mtp (Suc k) t1 + mtp k (raise k u) * mtp k t1;
                \<And>u k. mtp k (Subst k u t2) = mtp (Suc k) t2 + mtp k (raise k u) * mtp k t2\<rbrakk>
                    \<Longrightarrow> mtp k (Subst k u (t1 \<^bold>\<circ> t2)) =
                        mtp (Suc k) (t1 \<^bold>\<circ> t2) + mtp k (raise k u) * mtp k (t1 \<^bold>\<circ> t2)"
         by (auto simp add: distrib_left)
       show "\<And>t1 t2 u k.
               \<lbrakk>\<And>u k. mtp k (Subst k u t1) = mtp (Suc k) t1 + mtp k (raise k u) * mtp k t1;
                \<And>u k. mtp k (Subst k u t2) = mtp (Suc k) t2 + mtp k (raise k u) * mtp k t2\<rbrakk>
                   \<Longrightarrow> mtp k (Subst k u (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)) =
                       mtp (Suc k) (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) + mtp k (raise k u) * mtp k (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)"
       proof -
         fix t1 t2 u k
         assume ind1: "\<And>u k. mtp k (Subst k u t1) =
                              mtp (Suc k) t1 + mtp k (raise k u) * mtp k t1"
         assume ind2: "\<And>u k. mtp k (Subst k u t2) =
                              mtp (Suc k) t2 + mtp k (raise k u) * mtp k t2"
         show "mtp k (Subst k u (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)) =
               mtp (Suc k) (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) + mtp k (raise k u) * mtp k (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)"
         proof -
           have "mtp (Suc k) (Raise 0 (Suc k) u) * mtp (Suc k) t1 +
                   (mtp (Suc k) t2 + mtp k (Raise 0 k u) * mtp k t2) * max (Suc 0) (mtp 0 t1) =
                 mtp (Suc k) t2 * max (Suc 0) (mtp 0 t1) +
                   mtp k (Raise 0 k u) * (mtp (Suc k) t1 + mtp k t2 * max (Suc 0) (mtp 0 t1))"
           proof -
             have "mtp (Suc k) (Raise 0 (Suc k) u) * mtp (Suc k) t1 +
                     (mtp (Suc k) t2 + mtp k (Raise 0 k u) * mtp k t2) * max (Suc 0) (mtp 0 t1) =
                   mtp (Suc k) t2 * max (Suc 0) (mtp 0 t1) +
                     mtp (Suc k) (Raise 0 (Suc k) u) * mtp (Suc k) t1 +
                       mtp k (Raise 0 k u) * mtp k t2 * max (Suc 0) (mtp 0 t1)"
               by algebra
             also have "... = mtp (Suc k) t2 * max (Suc 0) (mtp 0 t1) +
                                mtp (Suc k) (Raise 0 (Suc k) u) * mtp (Suc k) t1 +
                                   mtp 0 u * mtp k t2 * max (Suc 0) (mtp 0 t1)"
               using mtp_Raise [of 0 0 0 k u] by auto
             also have "... = mtp (Suc k) t2 * max (Suc 0) (mtp 0 t1) +
                                mtp k (Raise 0 k u) *
                                  (mtp (Suc k) t1 + mtp k t2 * max (Suc 0) (mtp 0 t1))"
               by (metis (no_types, lifting) ab_semigroup_add_class.add_ac(1)
                   ab_semigroup_mult_class.mult_ac(1) add_mult_distrib2 le_add1 mtp_Raise
                   plus_nat.add_0)
             finally show ?thesis by blast
           qed
           thus ?thesis
             using ind1 ind2 mtp\<^sub>0_Subst_cancel by auto
         qed
       qed
     qed
 
     lemma mtp0_subst_le:
     shows "mtp 0 (subst u t) \<le> mtp 1 t + mtp 0 u * max 1 (mtp 0 t)"
     proof (cases t)
       show "t = \<^bold>\<sharp> \<Longrightarrow> mtp 0 (subst u t) \<le> mtp 1 t + mtp 0 u * max 1 (mtp 0 t)"
         by auto
       show "\<And>z. t = \<^bold>\<guillemotleft>z\<^bold>\<guillemotright> \<Longrightarrow> mtp 0 (subst u t) \<le> mtp 1 t + mtp 0 u * max 1 (mtp 0 t)"
         using Raise_0 by force
       show "\<And>P. t = \<^bold>\<lambda>\<^bold>[P\<^bold>] \<Longrightarrow> mtp 0 (subst u t) \<le> mtp 1 t + mtp 0 u * max 1 (mtp 0 t)"
         using mtp_Subst [of 0 u t] Raise_0 by force
       show "\<And>t1 t2. t = t1 \<^bold>\<circ> t2 \<Longrightarrow> mtp 0 (subst u t) \<le> mtp 1 t + mtp 0 u * max 1 (mtp 0 t)"
         using mtp_Subst Raise_0 add_mult_distrib2 nat_mult_max_right by auto
       show "\<And>t1 t2. t = \<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2 \<Longrightarrow> mtp 0 (subst u t) \<le> mtp 1 t + mtp 0 u * max 1 (mtp 0 t)"
         using mtp_Subst Raise_0
         by (metis Nat.add_0_right dual_order.eq_iff max_def mult.commute mult_zero_left
             not_less_eq_eq plus_1_eq_Suc trans_le_add1)
     qed
 
     lemma elementary_reduction_nonincreases_mtp:
-    shows "\<And>u x. \<lbrakk>elementary_reduction u; u \<sqsubseteq> t\<rbrakk> \<Longrightarrow> mtp x (resid t u) \<le> mtp x t"
-    proof (induct t)
+    shows "\<lbrakk>elementary_reduction u; u \<sqsubseteq> t\<rbrakk> \<Longrightarrow> mtp x (resid t u) \<le> mtp x t"
+    proof (induct t arbitrary: u x)
       show "\<And>u x. \<lbrakk>elementary_reduction u; u \<sqsubseteq> \<^bold>\<sharp>\<rbrakk> \<Longrightarrow> mtp x (resid \<^bold>\<sharp> u) \<le> mtp x \<^bold>\<sharp>"
         by simp
       show "\<And>x u i. \<lbrakk>elementary_reduction u; u \<sqsubseteq> \<^bold>\<guillemotleft>i\<^bold>\<guillemotright>\<rbrakk>
                           \<Longrightarrow> mtp x (resid \<^bold>\<guillemotleft>i\<^bold>\<guillemotright> u) \<le> mtp x \<^bold>\<guillemotleft>i\<^bold>\<guillemotright>"
         by (meson Ide.simps(2) elementary_reduction_not_ide ide_backward_stable ide_char
             subs_implies_prfx)
       fix u
       show "\<And>t x. \<lbrakk>\<And>u x. \<lbrakk>elementary_reduction u; u \<sqsubseteq> t\<rbrakk> \<Longrightarrow> mtp x (resid t u) \<le> mtp x t;
                    elementary_reduction u; u \<sqsubseteq> \<^bold>\<lambda>\<^bold>[t\<^bold>]\<rbrakk>
                      \<Longrightarrow> mtp x (\<^bold>\<lambda>\<^bold>[t\<^bold>] \\ u) \<le> mtp x \<^bold>\<lambda>\<^bold>[t\<^bold>]"
         by (cases u) auto
       show "\<And>t1 t2 x.
                \<lbrakk>\<And>u x. \<lbrakk>elementary_reduction u; u \<sqsubseteq> t1\<rbrakk> \<Longrightarrow> mtp x (resid t1 u) \<le> mtp x t1;
                 \<And>u x. \<lbrakk>elementary_reduction u; u \<sqsubseteq> t2\<rbrakk> \<Longrightarrow> mtp x (resid t2 u) \<le> mtp x t2;
                 elementary_reduction u; u \<sqsubseteq> t1 \<^bold>\<circ> t2\<rbrakk>
                   \<Longrightarrow> mtp x (resid (t1 \<^bold>\<circ> t2) u) \<le> mtp x (t1 \<^bold>\<circ> t2)"
         apply (cases u)
             apply auto
          apply (metis Coinitial_iff_Con add_mono_thms_linordered_semiring(3) resid_Arr_Ide)
         by (metis Coinitial_iff_Con add_mono_thms_linordered_semiring(2) resid_Arr_Ide)
       (*
        * TODO: Isabelle is sensitive to the order of assumptions in the induction hypotheses
        * stated in the "show". Why?
        *)
       show "\<And>t1 t2 x.
                \<lbrakk>\<And>u1 x. \<lbrakk>elementary_reduction u1; u1 \<sqsubseteq> t1\<rbrakk> \<Longrightarrow> mtp x (resid t1 u1) \<le> mtp x t1;
                 \<And>u2 x. \<lbrakk>elementary_reduction u2; u2 \<sqsubseteq> t2\<rbrakk> \<Longrightarrow> mtp x (resid t2 u2) \<le> mtp x t2;
                 elementary_reduction u; u \<sqsubseteq> \<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2\<rbrakk>
                   \<Longrightarrow> mtp x ((\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) \\ u) \<le> mtp x (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)"
       proof -
         fix t1 t2 x
         assume ind1: "\<And>u1 x. \<lbrakk>elementary_reduction u1; u1 \<sqsubseteq> t1\<rbrakk>
                                 \<Longrightarrow> mtp x (t1 \\ u1) \<le> mtp x t1"
         assume ind2: "\<And>u2 x. \<lbrakk>elementary_reduction u2; u2 \<sqsubseteq> t2\<rbrakk>
                                 \<Longrightarrow> mtp x (t2 \\ u2) \<le> mtp x t2"
         assume u: "elementary_reduction u"
         assume subs: "u \<sqsubseteq> \<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2"
         have 1: "is_App u \<or> is_Beta u"
           using subs by (metis prfx_Beta_iff subs_implies_prfx)
         have "is_App u \<Longrightarrow> mtp x ((\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) \\ u) \<le> mtp x (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)"
         proof -
           assume 2: "is_App u"
           obtain u1 u2 where u1u2: "u = \<^bold>\<lambda>\<^bold>[u1\<^bold>] \<^bold>\<circ> u2"
             using 2 u
             by (metis ConD(3) Con_implies_is_Lam_iff_is_Lam Con_sym con_def is_App_def is_Lam_def
                       lambda.disc(8) null_char prfx_implies_con subs subs_implies_prfx)
           have "mtp x ((\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) \\ u) = mtp x (\<^bold>\<lambda>\<^bold>[t1 \\ u1\<^bold>] \<^bold>\<Zspot> (t2 \\ u2))"
             using u1u2 subs
             by (metis Con_sym Ide.simps(1) ide_char resid.simps(6) subs_implies_prfx)
           also have "... = mtp (Suc x) (resid t1 u1) +
                            mtp x (resid t2 u2) * max 1 (mtp 0 (resid t1 u1))"
             by simp
           also have "... \<le> mtp (Suc x) t1 + mtp x (resid t2 u2) * max 1 (mtp 0 (resid t1 u1))"
             using u1u2 ind1 [of u1 "Suc x"] con_sym ide_char resid_arr_ide prfx_implies_con
                   subs subs_implies_prfx u
             by force
           also have "... \<le> mtp (Suc x) t1 + mtp x t2 * max 1 (mtp 0 (resid t1 u1))"
             using u1u2 ind2 [of u2 x]
             by (metis (no_types, lifting) Con_implies_Coinitial_ind add_left_mono
                 dual_order.eq_iff elementary_reduction.simps(4) lambda.disc(11)
                 mult_le_cancel2 prfx_App_iff resid.simps(31) resid_Arr_Ide subs subs.simps(4)
                 subs_implies_prfx u)
           also have "... \<le> mtp (Suc x) t1 + mtp x t2 * max 1 (mtp 0 t1)"
             using ind1 [of u1 0]
             by (metis Con_implies_Coinitial_ind Ide.simps(3) elementary_reduction.simps(3)
                 elementary_reduction.simps(4) lambda.disc(11) max.mono mult_le_mono
                 nat_add_left_cancel_le nat_le_linear prfx_App_iff resid.simps(31) resid_Arr_Ide
                 subs subs.simps(4) subs_implies_prfx u u1u2)
           also have "... = mtp x (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)"
             by auto
           finally show "mtp x ((\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) \\ u) \<le> mtp x (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)" by blast
         qed
         moreover have "is_Beta u \<Longrightarrow> mtp x ((\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) \\ u) \<le> mtp x (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)"
         proof -
           assume 2: "is_Beta u"
           obtain u1 u2 where u1u2: "u = \<^bold>\<lambda>\<^bold>[u1\<^bold>] \<^bold>\<Zspot> u2"
             using 2 u is_Beta_def by auto
           have "mtp x ((\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) \\ u) = mtp x (subst (t2 \\ u2) (t1 \\ u1))"
             using u1u2 subs
             by (metis con_def con_sym null_char prfx_implies_con resid.simps(4) subs_implies_prfx)
           also have "... \<le> mtp (Suc x) (resid t1 u1) +
                              mtp x (resid t2 u2) * max 1 (mtp 0 (resid t1 u1))"
             apply (cases "x = 0")
             using mtp0_subst_le Raise_0 mtp_Subst' [of "x - 1" 0 "resid t2 u2" "resid t1 u1"]
             by auto
           also have "... \<le> mtp (Suc x) t1 + mtp x t2 * max 1 (mtp 0 t1)"
             using ind1 ind2
             apply simp
             by (metis Coinitial_iff_Con Ide.simps(1) dual_order.eq_iff elementary_reduction.simps(5)
                 ide_char resid.simps(4) resid_Arr_Ide subs subs_implies_prfx u u1u2)
           also have "... = mtp x (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)"
             by simp
           finally show "mtp x ((\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) \\ u) \<le> mtp x (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)" by blast
         qed
         ultimately show "mtp x ((\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) \\ u) \<le> mtp x (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)"
           using 1 by blast
       qed
     qed
 
     text \<open>
       Next we define the ``height'' of a term.  This counts the number of steps in a development
       of maximal length of the given term.
     \<close>
 
     fun hgt
     where "hgt \<^bold>\<sharp> = 0"
         | "hgt \<^bold>\<guillemotleft>_\<^bold>\<guillemotright> = 0"
         | "hgt \<^bold>\<lambda>\<^bold>[t\<^bold>] = hgt t"
         | "hgt (t \<^bold>\<circ> u) = hgt t + hgt u"
         | "hgt (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) = Suc (hgt t + hgt u * max 1 (mtp 0 t))"
 
     lemma hgt_resid_ide:
     shows "\<lbrakk>ide u; u \<sqsubseteq> t\<rbrakk> \<Longrightarrow> hgt (resid t u) \<le> hgt t"
       by (metis con_sym eq_imp_le resid_arr_ide prfx_implies_con subs_implies_prfx)
 
     lemma hgt_Raise:
-    shows "\<And>l k. hgt (Raise l k t) = hgt t"
+    shows "hgt (Raise l k t) = hgt t"
       using mtpE_eq_Raise
-      by (induct t) auto
+      by (induct t arbitrary: l k) auto
 
     lemma hgt_Subst:
-    shows "\<And>u k. Arr u \<Longrightarrow> hgt (Subst k u t) = hgt t + hgt u * mtp k t"
-    proof (induct t)
+    shows "Arr u \<Longrightarrow> hgt (Subst k u t) = hgt t + hgt u * mtp k t"
+    proof (induct t arbitrary: u k)
       show "\<And>u k. Arr u \<Longrightarrow> hgt (Subst k u \<^bold>\<sharp>) = hgt \<^bold>\<sharp> + hgt u * mtp k \<^bold>\<sharp>"
         by simp
       show "\<And>x u k. Arr u \<Longrightarrow> hgt (Subst k u \<^bold>\<guillemotleft>x\<^bold>\<guillemotright>) = hgt \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> + hgt u * mtp k \<^bold>\<guillemotleft>x\<^bold>\<guillemotright>"
         using hgt_Raise by auto
       show "\<And>t u k. \<lbrakk>\<And>u k. Arr u \<Longrightarrow> hgt (Subst k u t) = hgt t + hgt u * mtp k t; Arr u\<rbrakk>
                        \<Longrightarrow> hgt (Subst k u \<^bold>\<lambda>\<^bold>[t\<^bold>]) = hgt \<^bold>\<lambda>\<^bold>[t\<^bold>] + hgt u * mtp k \<^bold>\<lambda>\<^bold>[t\<^bold>]"
         by auto
       show "\<And>t1 t2 u k.
               \<lbrakk>\<And>u k. Arr u \<Longrightarrow> hgt (Subst k u t1) = hgt t1 + hgt u * mtp k t1;
                \<And>u k. Arr u \<Longrightarrow> hgt (Subst k u t2) = hgt t2 + hgt u * mtp k t2; Arr u\<rbrakk>
                    \<Longrightarrow> hgt (Subst k u (t1 \<^bold>\<circ> t2)) = hgt (t1 \<^bold>\<circ> t2) + hgt u * mtp k (t1 \<^bold>\<circ> t2)"
         by (simp add: distrib_left)
       show "\<And>t1 t2 u k.
                \<lbrakk>\<And>u k. Arr u \<Longrightarrow> hgt (Subst k u t1) = hgt t1 + hgt u * mtp k t1;
                 \<And>u k. Arr u \<Longrightarrow> hgt (Subst k u t2) = hgt t2 + hgt u * mtp k t2; Arr u\<rbrakk>
                   \<Longrightarrow> hgt (Subst k u (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)) = hgt (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) + hgt u * mtp k (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)"
       proof -
         fix t1 t2 u k
         assume ind1: "\<And>u k. Arr u \<Longrightarrow> hgt (Subst k u t1) = hgt t1 + hgt u * mtp k t1"
         assume ind2: "\<And>u k. Arr u \<Longrightarrow> hgt (Subst k u t2) = hgt t2 + hgt u * mtp k t2"
         assume u: "Arr u"
         show "hgt (Subst k u (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)) = hgt (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) + hgt u * mtp k (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)"
         proof -
           have "hgt (Subst k u (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)) =
                 Suc (hgt (Subst (Suc k) u t1) +
                   hgt (Subst k u t2) * max 1 (mtp 0 (Subst (Suc k) u t1)))"
             by simp
           also have "... = Suc ((hgt t1 + hgt u * mtp (Suc k) t1) +
                                 (hgt t2 + hgt u * mtp k t2) * max 1 (mtp 0 (Subst (Suc k) u t1)))"
             using u ind1 [of u "Suc k"] ind2 [of u k] by simp
           also have "... = Suc (hgt t1 + hgt t2 * max 1 (mtp 0 (Subst (Suc k) u t1)) +
                                 hgt u * mtp (Suc k) t1) +
                                 hgt u * mtp k t2 * max 1 (mtp 0 (Subst (Suc k) u t1))"
             using comm_semiring_class.distrib by force
           also have "... = Suc (hgt t1 + hgt t2 * max 1 (mtp 0 (Subst (Suc k) u t1)) +
                                 hgt u * (mtp (Suc k) t1 +
                                            mtp k t2 * max 1 (mtp 0 (Subst (Suc k) u t1))))"
             by (simp add: distrib_left)
           also have "... = Suc (hgt t1 + hgt t2 * max 1 (mtp 0 t1) +
                                 hgt u * (mtp (Suc k) t1 +
                                            mtp k t2 * max 1 (mtp 0 t1)))"
           proof -
             have "mtp 0 (Subst (Suc k) u t1) = mtp 0 t1"
               using mtp\<^sub>0_Subst_cancel by auto
             thus ?thesis by simp
           qed
           also have "... = hgt (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) + hgt u * mtp k (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)"
             by simp
           finally show ?thesis by blast
         qed
       qed
     qed
 
     lemma elementary_reduction_decreases_hgt:
-    shows "\<And>u. \<lbrakk>elementary_reduction u; u \<sqsubseteq> t\<rbrakk> \<Longrightarrow> hgt (t \\ u) < hgt t"
-    proof (induct t)
+    shows "\<lbrakk>elementary_reduction u; u \<sqsubseteq> t\<rbrakk> \<Longrightarrow> hgt (t \\ u) < hgt t"
+    proof (induct t arbitrary: u)
       show "\<And>u. \<lbrakk>elementary_reduction u; u \<sqsubseteq> \<^bold>\<sharp>\<rbrakk> \<Longrightarrow> hgt (\<^bold>\<sharp> \\ u) < hgt \<^bold>\<sharp>"
         by simp
       show "\<And>u x. \<lbrakk>elementary_reduction u; u \<sqsubseteq> \<^bold>\<guillemotleft>x\<^bold>\<guillemotright>\<rbrakk> \<Longrightarrow> hgt (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \\ u) < hgt \<^bold>\<guillemotleft>x\<^bold>\<guillemotright>"
         using Ide.simps(2) elementary_reduction_not_ide ide_backward_stable ide_char
               subs_implies_prfx
         by blast
       show "\<And>t u. \<lbrakk>\<And>u. \<lbrakk>elementary_reduction u; u \<sqsubseteq> t\<rbrakk> \<Longrightarrow> hgt (t \\ u) < hgt t;
                    elementary_reduction u; u \<sqsubseteq> \<^bold>\<lambda>\<^bold>[t\<^bold>]\<rbrakk>
                      \<Longrightarrow> hgt (\<^bold>\<lambda>\<^bold>[t\<^bold>] \\ u) < hgt \<^bold>\<lambda>\<^bold>[t\<^bold>]"
       proof -
         fix t u
         assume ind: "\<And>u. \<lbrakk>elementary_reduction u; u \<sqsubseteq> t\<rbrakk> \<Longrightarrow> hgt (t \\ u) < hgt t"
         assume u: "elementary_reduction u"
         assume subs: "u \<sqsubseteq> \<^bold>\<lambda>\<^bold>[t\<^bold>]"
         show "hgt (\<^bold>\<lambda>\<^bold>[t\<^bold>] \\ u) < hgt \<^bold>\<lambda>\<^bold>[t\<^bold>]"
           using u subs ind
           apply (cases u)
               apply simp_all
           by fastforce
       qed
       show "\<And>t1 t2 u.
               \<lbrakk>\<And>u. \<lbrakk>elementary_reduction u; u \<sqsubseteq> t1\<rbrakk> \<Longrightarrow> hgt (t1 \\ u) < hgt t1;
                \<And>u. \<lbrakk>elementary_reduction u; u \<sqsubseteq> t2\<rbrakk> \<Longrightarrow> hgt (t2 \\ u) < hgt t2;
                elementary_reduction u; u \<sqsubseteq> t1 \<^bold>\<circ> t2\<rbrakk>
                   \<Longrightarrow> hgt ((t1 \<^bold>\<circ> t2) \\ u) < hgt (t1 \<^bold>\<circ> t2)"
       proof -
         fix t1 t2 u
         assume ind1: "\<And>u. \<lbrakk>elementary_reduction u; u \<sqsubseteq> t1\<rbrakk> \<Longrightarrow> hgt (t1 \\ u) < hgt t1"
         assume ind2: "\<And>u. \<lbrakk>elementary_reduction u; u \<sqsubseteq> t2\<rbrakk> \<Longrightarrow> hgt (t2 \\ u) < hgt t2"
         assume u: "elementary_reduction u"
         assume subs: "u \<sqsubseteq> t1 \<^bold>\<circ> t2"
         show "hgt ((t1 \<^bold>\<circ> t2) \\ u) < hgt (t1 \<^bold>\<circ> t2)"
           using u subs ind1 ind2
           apply (cases u)
               apply simp_all
           by (metis add_le_less_mono add_less_le_mono hgt_resid_ide ide_char not_less0
                     zero_less_iff_neq_zero)
       qed
       show "\<And>t1 t2 u.
               \<lbrakk>\<And>u. \<lbrakk>elementary_reduction u; u \<sqsubseteq> t1\<rbrakk> \<Longrightarrow> hgt (t1 \\ u) < hgt t1;
                \<And>u. \<lbrakk>elementary_reduction u; u \<sqsubseteq> t2\<rbrakk> \<Longrightarrow> hgt (t2 \\ u) < hgt t2;
                elementary_reduction u; u \<sqsubseteq> \<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2\<rbrakk>
                   \<Longrightarrow> hgt ((\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) \\ u) < hgt (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)"
       proof -
         fix t1 t2 u
         assume ind1: "\<And>u. \<lbrakk>elementary_reduction u; u \<sqsubseteq> t1\<rbrakk> \<Longrightarrow> hgt (t1 \\ u) < hgt t1"
         assume ind2: "\<And>u. \<lbrakk>elementary_reduction u; u \<sqsubseteq> t2\<rbrakk> \<Longrightarrow> hgt (t2 \\ u) < hgt t2"
         assume u: "elementary_reduction u"
         assume subs: "u \<sqsubseteq> \<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2"
         have "is_App u \<or> is_Beta u"
           using subs by (metis prfx_Beta_iff subs_implies_prfx)
         moreover have "is_App u \<Longrightarrow> hgt ((\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) \\ u) < hgt (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)"
         proof -
           fix u1 u2
           assume 0: "is_App u"
           obtain u1 u1' u2 where 1: "u = u1 \<^bold>\<circ> u2 \<and> u1 = \<^bold>\<lambda>\<^bold>[u1'\<^bold>]"
             using u 0
             by (metis ConD(3) Con_implies_is_Lam_iff_is_Lam Con_sym con_def is_App_def is_Lam_def
                       null_char prfx_implies_con subs subs_implies_prfx)
           have "hgt ((\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) \\ u) = hgt ((\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) \\ (u1 \<^bold>\<circ> u2))"
             using 1 by simp
           also have "... = hgt (\<^bold>\<lambda>\<^bold>[t1 \\ u1'\<^bold>] \<^bold>\<Zspot> t2 \\ u2)"
             by (metis "1" Con_sym Ide.simps(1) ide_char resid.simps(6) subs subs_implies_prfx)
           also have "... = Suc (hgt (t1 \\ u1') + hgt (t2 \\ u2) * max (Suc 0) (mtp 0 (t1 \\ u1')))"
             by auto
           also have "... < hgt (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)"
           proof -
             have "elementary_reduction (un_App1 u) \<and> ide (un_App2 u) \<or>
                   ide (un_App1 u) \<and> elementary_reduction (un_App2 u)"
               using u 1 elementary_reduction_App_iff [of u] by simp
             moreover have "elementary_reduction (un_App1 u) \<and> ide (un_App2 u) \<Longrightarrow> ?thesis"
             proof -
               assume 2: "elementary_reduction (un_App1 u) \<and> ide (un_App2 u)"
               have "elementary_reduction u1' \<and> ide (un_App2 u)"
                 using 1 2 u elementary_reduction_Lam_iff by force
               moreover have "mtp 0 (t1 \\ u1') \<le> mtp 0 t1"
                 using 1 calculation elementary_reduction_nonincreases_mtp subs
                       subs.simps(4)
                 by blast
               moreover have "mtp 0 (t2 \\ u2) \<le> mtp 0 t2"
                 using 1 hgt_resid_ide [of u2 t2]
                 by (metis calculation(1) con_sym eq_refl resid_arr_ide lambda.sel(4)
                     prfx_implies_con subs subs.simps(4) subs_implies_prfx)
               ultimately show ?thesis
                 using 1 2 ind1 [of u1'] hgt_resid_ide
                 apply simp
                 by (metis "1" Suc_le_mono \<open>mtp 0 (t1 \ u1') \<le> mtp 0 t1\<close> add_less_le_mono
                     le_add1 le_add_same_cancel1 max.mono mult_le_mono subs subs.simps(4))
             qed
             moreover have "ide (un_App1 u) \<and> elementary_reduction (un_App2 u) \<Longrightarrow> ?thesis"
             proof -
               assume 2: "ide (un_App1 u) \<and> elementary_reduction (un_App2 u)"
               have "ide (un_App1 u) \<and> elementary_reduction u2"
                 using 1 2 u elementary_reduction_Lam_iff by force
               moreover have "mtp 0 (t1 \\ u1') \<le> mtp 0 t1"
                 using 1 hgt_resid_ide [of u1' t1]
                 by (metis Ide.simps(3) calculation con_sym eq_refl ide_char resid_arr_ide
                     lambda.sel(3) prfx_implies_con subs subs.simps(4) subs_implies_prfx)
               moreover have "mtp 0 (t2 \\ u2) \<le> mtp 0 t2"
                 using 1 elementary_reduction_nonincreases_mtp subs calculation(1) subs.simps(4)
                 by blast
               ultimately show ?thesis
                 using 1 2 ind2 [of u2]
                 apply simp
                 by (metis Coinitial_iff_Con Ide_iff_Src_self Nat.add_0_right add_le_less_mono
                           ide_char Ide.simps(1) subs.simps(4) le_add1 max_nat.neutr_eq_iff
                           mult_less_cancel2 nat.distinct(1) neq0_conv resid_Arr_Src subs
                           subs_implies_prfx)
             qed
             ultimately show ?thesis by blast
           qed
           also have "... = Suc (hgt t1 + hgt t2 * max 1 (mtp 0 t1))"
             by simp
           also have "... = hgt (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)"
             by simp
           finally show "hgt ((\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) \\ u) < hgt (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)"
             by blast
         qed
         moreover have "is_Beta u \<Longrightarrow> hgt ((\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) \\ u) < hgt (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)"
         proof -
           fix u1 u2
           assume 0: "is_Beta u"
           obtain u1 u2 where 1: "u = \<^bold>\<lambda>\<^bold>[u1\<^bold>] \<^bold>\<Zspot> u2"
             using u 0 by (metis lambda.collapse(4))
           have "hgt ((\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) \\ u) = hgt ((\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) \\ (\<^bold>\<lambda>\<^bold>[u1\<^bold>] \<^bold>\<Zspot> u2))"
             using 1 by simp
           also have "... = hgt (subst (resid t2 u2) (resid t1 u1))"
             by (metis "1" con_def con_sym null_char prfx_implies_con resid.simps(4)
                 subs subs_implies_prfx)
           also have "... = hgt (resid t1 u1) + hgt (resid t2 u2) * mtp 0 (resid t1 u1)"
           proof -
             have "Arr (resid t2 u2)"
               by (metis "1" Coinitial_resid_resid Con_sym Ide.simps(1) ide_char resid.simps(4)
                   subs subs_implies_prfx)
             thus ?thesis
               using hgt_Subst [of "resid t2 u2" 0 "resid t1 u1"] by simp
           qed
           also have "... < hgt (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)"
           proof -
             have "ide u1 \<and> ide u2"
               using u 1 elementary_reduction_Beta_iff [of u] by auto
            thus ?thesis
              using 1 hgt_resid_ide
              by (metis add_le_mono con_sym hgt.simps(5) resid_arr_ide less_Suc_eq_le
                  max.cobounded2 nat_mult_max_right prfx_implies_con subs subs.simps(5)
                  subs_implies_prfx)
           qed
           finally show "hgt ((\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) \\ u) < hgt (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)"
             by blast
         qed
         ultimately show "hgt ((\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) \\ u) < hgt (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)" by blast
       qed
     qed
 
   end
 
   context reduction_paths
   begin
 
     lemma length_devel_le_hgt:
-    shows "\<And>t. development t U \<Longrightarrow> length U \<le> \<Lambda>.hgt t"
+    shows "development t U \<Longrightarrow> length U \<le> \<Lambda>.hgt t"
       using \<Lambda>.elementary_reduction_decreases_hgt
-      by (induct U, auto, fastforce)
+      by (induct U arbitrary: t, auto, fastforce)
 
     text \<open>
       We finally arrive at the main result of this section:
       the Finite Developments Theorem.
     \<close>
 
     theorem finite_developments:
     shows "FD t"
       using length_devel_le_hgt [of t] FD_def by auto
 
     subsection "Complete Developments"
 
     text \<open>
       A \emph{complete development} is a development in which there are no residuals of originally
       marked redexes left to contract.
     \<close>
 
     definition complete_development
     where "complete_development t U \<equiv> development t U \<and> (\<Lambda>.Ide t \<or> [t] \<^sup>*\<lesssim>\<^sup>* U)"
 
     lemma complete_development_Ide_iff:
     shows "complete_development t U \<Longrightarrow> \<Lambda>.Ide t \<longleftrightarrow> U = []"
       using complete_development_def development_Ide Ide.simps(1) ide_char
       by (induct t) auto
 
     lemma complete_development_cons:
     assumes "complete_development t (u # U)"
     shows "complete_development (t \\ u) U"
       using assms complete_development_def
       by (metis Ide.simps(1) Ide.simps(2) Resid_rec(1) Resid_rec(3)
           complete_development_Ide_iff ide_char development.simps(2)
           \<Lambda>.ide_char list.simps(3))
 
     lemma complete_development_cong:
-    shows "\<And>t. \<lbrakk>complete_development t U; \<not> \<Lambda>.Ide t\<rbrakk> \<Longrightarrow> [t] \<^sup>*\<sim>\<^sup>* U"
+    shows "\<lbrakk>complete_development t U; \<not> \<Lambda>.Ide t\<rbrakk> \<Longrightarrow> [t] \<^sup>*\<sim>\<^sup>* U"
       using complete_development_def development_implies
       by (induct U) auto
 
     lemma complete_developments_cong:
     assumes "\<not> \<Lambda>.Ide t" and "complete_development t U" and "complete_development t V"
     shows "U \<^sup>*\<sim>\<^sup>* V"
       using assms complete_development_cong [of "t"] cong_symmetric cong_transitive
       by blast
 
     lemma Trgs_complete_development:
-    shows "\<And>t. \<lbrakk>complete_development t U; \<not> \<Lambda>.Ide t\<rbrakk> \<Longrightarrow> Trgs U = {\<Lambda>.Trg t}"
+    shows "\<lbrakk>complete_development t U; \<not> \<Lambda>.Ide t\<rbrakk> \<Longrightarrow> Trgs U = {\<Lambda>.Trg t}"
       using complete_development_cong Ide.simps(1) Srcs_Resid Trgs.simps(2)
             Trgs_Resid_sym ide_char complete_development_def development_imp_Arr \<Lambda>.targets_char\<^sub>\<Lambda>
       apply simp
       by (metis Srcs_Resid Trgs.simps(2) con_char ide_def)
 
     text \<open>
       Now that we know all developments are finite, it is easy to construct a complete development
       by an iterative process that at each stage contracts one of the remaining marked redexes
       at each stage.  It is also possible to construct a complete development by structural
       induction without using the finite developments property, but it is more work to prove the
       correctness.
     \<close>
 
     fun (in lambda_calculus) bottom_up_redex
     where "bottom_up_redex \<^bold>\<sharp> = \<^bold>\<sharp>"
         | "bottom_up_redex \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> = \<^bold>\<guillemotleft>x\<^bold>\<guillemotright>"
         | "bottom_up_redex \<^bold>\<lambda>\<^bold>[M\<^bold>] = \<^bold>\<lambda>\<^bold>[bottom_up_redex M\<^bold>]"
         | "bottom_up_redex (M \<^bold>\<circ> N) =
              (if \<not> Ide M then bottom_up_redex M \<^bold>\<circ> Src N else M \<^bold>\<circ> bottom_up_redex N)"
         | "bottom_up_redex (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) =
              (if \<not> Ide M then \<^bold>\<lambda>\<^bold>[bottom_up_redex M\<^bold>] \<^bold>\<circ> Src N
               else if \<not> Ide N then \<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<circ> bottom_up_redex N
               else \<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N)"
 
     lemma (in lambda_calculus) elementary_reduction_bottom_up_redex:
     shows "\<lbrakk>Arr t; \<not> Ide t\<rbrakk> \<Longrightarrow> elementary_reduction (bottom_up_redex t)"
       using Ide_Src
       by (induct t) auto
 
     lemma (in lambda_calculus) subs_bottom_up_redex:
     shows "Arr t \<Longrightarrow> bottom_up_redex t \<sqsubseteq> t"
       apply (induct t)
           apply auto[3]
        apply (metis Arr.simps(4) Ide.simps(4) Ide_Src Ide_iff_Src_self Ide_implies_Arr
                     bottom_up_redex.simps(4) ide_char lambda.disc(14) lambda.sel(3) lambda.sel(4)
                     subs_App subs_Ide)
       by (metis Arr.simps(5) Ide_Src Ide_iff_Src_self Ide_implies_Arr bottom_up_redex.simps(5)
                 ide_char subs.simps(4) subs.simps(5) subs_Ide)
 
     function (sequential) bottom_up_development
     where "bottom_up_development t =
            (if \<not> \<Lambda>.Arr t \<or> \<Lambda>.Ide t then []
             else \<Lambda>.bottom_up_redex t # (bottom_up_development (t \\ \<Lambda>.bottom_up_redex t)))"
       by pat_completeness auto
 
     termination bottom_up_development
       using \<Lambda>.elementary_reduction_decreases_hgt \<Lambda>.elementary_reduction_bottom_up_redex
             \<Lambda>.subs_bottom_up_redex
       by (relation "measure \<Lambda>.hgt") auto
 
     lemma complete_development_bottom_up_development_ind:
-    shows "\<And>t. \<lbrakk>\<Lambda>.Arr t; length (bottom_up_development t) \<le> n\<rbrakk>
-                  \<Longrightarrow> complete_development t (bottom_up_development t)"
-    proof (induct n)
+    shows "\<lbrakk>\<Lambda>.Arr t; length (bottom_up_development t) \<le> n\<rbrakk>
+              \<Longrightarrow> complete_development t (bottom_up_development t)"
+    proof (induct n arbitrary: t)
       show "\<And>t. \<lbrakk>\<Lambda>.Arr t; length (bottom_up_development t) \<le> 0\<rbrakk>
                    \<Longrightarrow> complete_development t (bottom_up_development t)"
         using complete_development_def development_Ide by auto
       show "\<And>n t. \<lbrakk>\<And>t. \<lbrakk>\<Lambda>.Arr t; length (bottom_up_development t) \<le> n\<rbrakk>
                            \<Longrightarrow> complete_development t (bottom_up_development t);
                    \<Lambda>.Arr t; length (bottom_up_development t) \<le> Suc n\<rbrakk>
                      \<Longrightarrow> complete_development t (bottom_up_development t)"
       proof -
         fix n t
         assume t: "\<Lambda>.Arr t"
         assume n: "length (bottom_up_development t) \<le> Suc n"
         assume ind: "\<And>t. \<lbrakk>\<Lambda>.Arr t; length (bottom_up_development t) \<le> n\<rbrakk>
                            \<Longrightarrow> complete_development t (bottom_up_development t)"
         show "complete_development t (bottom_up_development t)"
         proof (cases "bottom_up_development t")
           show "bottom_up_development t = [] \<Longrightarrow> ?thesis"
             using ind t by force
           fix u U
           assume uU: "bottom_up_development t = u # U"
           have 1: "\<Lambda>.elementary_reduction u \<and> u \<sqsubseteq> t"
             using t uU
             by (metis bottom_up_development.simps \<Lambda>.elementary_reduction_bottom_up_redex
                 list.inject list.simps(3) \<Lambda>.subs_bottom_up_redex)
           moreover have "complete_development (\<Lambda>.resid t u) U"
             using 1 ind
             by (metis Suc_le_length_iff \<Lambda>.arr_char \<Lambda>.arr_resid_iff_con bottom_up_development.simps
                       list.discI list.inject n not_less_eq_eq \<Lambda>.prfx_implies_con
                       \<Lambda>.con_sym \<Lambda>.subs_implies_prfx uU)
           ultimately show ?thesis
             by (metis Con_sym Ide.simps(2) Resid_rec(1) Resid_rec(3)
                 complete_development_Ide_iff complete_development_def ide_char
                 development.simps(2) development_implies \<Lambda>.ide_char list.simps(3) uU)
         qed
       qed
     qed
 
     lemma complete_development_bottom_up_development:
     assumes "\<Lambda>.Arr t"
     shows "complete_development t (bottom_up_development t)"
       using assms complete_development_bottom_up_development_ind by blast
 
   end
 
   section "Reduction Strategies"
 
   context lambda_calculus
   begin
 
     text \<open>
       A \emph{reduction strategy} is a function taking an identity term to an arrow having that
       identity as its source.
     \<close>
 
     definition reduction_strategy
     where "reduction_strategy f \<longleftrightarrow> (\<forall>t. Ide t \<longrightarrow> Coinitial (f t) t)"
 
     text \<open>
       The following defines the iterated application of a reduction strategy to an identity term.
     \<close>
 
     fun reduce
     where "reduce f a 0 = a"
         | "reduce f a (Suc n) = reduce f (Trg (f a)) n"
 
     lemma red_reduce:
     assumes "reduction_strategy f"
-    shows "\<And>a. Ide a \<Longrightarrow> red a (reduce f a n)"
-      apply (induct n, auto)
+    shows "Ide a \<Longrightarrow> red a (reduce f a n)"
+      apply (induct n arbitrary: a, auto)
        apply (metis Ide_iff_Src_self Ide_iff_Trg_self Ide_implies_Arr red.simps)
       by (metis Ide_Trg Ide_iff_Src_self assms red.intros(1) red.intros(2) reduction_strategy_def)
 
     text \<open>
       A reduction strategy is \emph{normalizing} if iterated application of it to a normalizable
       term eventually yields a normal form.
     \<close>
 
     definition normalizing_strategy
     where "normalizing_strategy f \<longleftrightarrow> (\<forall>a. normalizable a \<longrightarrow> (\<exists>n. NF (reduce f a n)))"
 
   end
 
   context reduction_paths
   begin
 
     text \<open>
       The following function constructs the reduction path that results by iterating the
       application of a reduction strategy to a term.
     \<close>
 
     fun apply_strategy
     where "apply_strategy f a 0 = []"
         | "apply_strategy f a (Suc n) = f a # apply_strategy f (\<Lambda>.Trg (f a)) n"
 
     lemma apply_strategy_gives_path_ind:
     assumes "\<Lambda>.reduction_strategy f"
-    shows "\<And>a. \<lbrakk>\<Lambda>.Ide a; n > 0\<rbrakk> \<Longrightarrow> Arr (apply_strategy f a n) \<and>
-                                    length (apply_strategy f a n) = n \<and>
-                                    Src (apply_strategy f a n) = a \<and>
-                                    Trg (apply_strategy f a n) = \<Lambda>.reduce f a n"
-    proof (induct n, simp)
+    shows "\<lbrakk>\<Lambda>.Ide a; n > 0\<rbrakk> \<Longrightarrow> Arr (apply_strategy f a n) \<and>
+                                length (apply_strategy f a n) = n \<and>
+                                Src (apply_strategy f a n) = a \<and>
+                                Trg (apply_strategy f a n) = \<Lambda>.reduce f a n"
+    proof (induct n arbitrary: a, simp)
       fix n a
       assume ind: "\<And>a. \<lbrakk>\<Lambda>.Ide a; 0 < n\<rbrakk> \<Longrightarrow> Arr (apply_strategy f a n) \<and>
                                             length (apply_strategy f a n) = n \<and>
                                             Src (apply_strategy f a n) = a \<and>
                                             Trg (apply_strategy f a n) = \<Lambda>.reduce f a n"
       assume a: "\<Lambda>.Ide a"
       show "Arr (apply_strategy f a (Suc n)) \<and>
             length (apply_strategy f a (Suc n)) = Suc n \<and>
             Src (apply_strategy f a (Suc n)) = a \<and>
             Trg (apply_strategy f a (Suc n)) = \<Lambda>.reduce f a (Suc n)"
       proof (intro conjI)
         have 1: "\<Lambda>.Arr (f a) \<and> \<Lambda>.Src (f a) = a"
           using assms a \<Lambda>.reduction_strategy_def
           by (metis \<Lambda>.Ide_iff_Src_self)
         show "Arr (apply_strategy f a (Suc n))"
           using "1" Arr.elims(3) ind \<Lambda>.targets_char\<^sub>\<Lambda> \<Lambda>.Ide_Trg by fastforce
         show "Src (apply_strategy f a (Suc n)) = a"
           by (simp add: "1")
         show "length (apply_strategy f a (Suc n)) = Suc n"
           by (metis "1" \<Lambda>.Ide_Trg One_nat_def Suc_eq_plus1 ind list.size(3) list.size(4)
               neq0_conv apply_strategy.simps(1) apply_strategy.simps(2))
         show "Trg (apply_strategy f a (Suc n)) = \<Lambda>.reduce f a (Suc n)"
         proof (cases "apply_strategy f (\<Lambda>.Trg (f a)) n = []")
           show "apply_strategy f (\<Lambda>.Trg (f a)) n = [] \<Longrightarrow> ?thesis"
             using a 1 ind [of "\<Lambda>.Trg (f a)"] \<Lambda>.Ide_Trg \<Lambda>.targets_char\<^sub>\<Lambda> by force
           assume 2: "apply_strategy f (\<Lambda>.Trg (f a)) n \<noteq> []"
           have "Trg (apply_strategy f a (Suc n)) = Trg (apply_strategy f (\<Lambda>.Trg (f a)) n)"
             using a 1 ind [of "\<Lambda>.Trg (f a)"]
             by (simp add: "2")
           also have "... = \<Lambda>.reduce f a (Suc n)"
             using 1 2 \<Lambda>.Ide_Trg ind [of "\<Lambda>.Trg (f a)"] by fastforce
           finally show ?thesis by blast
         qed
       qed
     qed
 
     lemma apply_strategy_gives_path:
     assumes "\<Lambda>.reduction_strategy f" and "\<Lambda>.Ide a" and "n > 0"
     shows "Arr (apply_strategy f a n)"
     and "length (apply_strategy f a n) = n"
     and "Src (apply_strategy f a n) = a"
     and "Trg (apply_strategy f a n) = \<Lambda>.reduce f a n"
       using assms apply_strategy_gives_path_ind by auto
 
     lemma reduce_eq_Trg_apply_strategy:
     assumes "\<Lambda>.reduction_strategy S" and "\<Lambda>.Ide a"
     shows "n > 0 \<Longrightarrow> \<Lambda>.reduce S a n = Trg (apply_strategy S a n)"
       using assms
       apply (induct n)
        apply simp_all
       by (metis Arr.simps(1) Trg_simp apply_strategy_gives_path_ind \<Lambda>.Ide_Trg
           \<Lambda>.reduce.simps(1) \<Lambda>.reduction_strategy_def \<Lambda>.trg_char neq0_conv
           apply_strategy.simps(1))
 
   end
 
   subsection "Parallel Reduction"
 
   context lambda_calculus
   begin
 
     text \<open>
        \emph{Parallel reduction} is the strategy that contracts all available redexes at each step.
     \<close>
 
     fun parallel_strategy
     where "parallel_strategy \<^bold>\<guillemotleft>i\<^bold>\<guillemotright> = \<^bold>\<guillemotleft>i\<^bold>\<guillemotright>"
         | "parallel_strategy \<^bold>\<lambda>\<^bold>[t\<^bold>] = \<^bold>\<lambda>\<^bold>[parallel_strategy t\<^bold>]"
         | "parallel_strategy (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<circ> u) = \<^bold>\<lambda>\<^bold>[parallel_strategy t\<^bold>] \<^bold>\<Zspot> parallel_strategy u"
         | "parallel_strategy (t \<^bold>\<circ> u) = parallel_strategy t \<^bold>\<circ> parallel_strategy u"
         | "parallel_strategy (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) = \<^bold>\<lambda>\<^bold>[parallel_strategy t\<^bold>] \<^bold>\<Zspot> parallel_strategy u"
         | "parallel_strategy \<^bold>\<sharp> = \<^bold>\<sharp>"
 
     lemma parallel_strategy_is_reduction_strategy:
     shows "reduction_strategy parallel_strategy"
     proof (unfold reduction_strategy_def, intro allI impI)
       fix t
       show "Ide t \<Longrightarrow> Coinitial (parallel_strategy t) t"
         using Ide_implies_Arr
         apply (induct t, auto)
         by force+
     qed
 
     lemma parallel_strategy_Src_eq:
     shows "Arr t \<Longrightarrow> parallel_strategy (Src t) = parallel_strategy t"
       by (induct t) auto
 
     lemma subs_parallel_strategy_Src:
     shows "Arr t \<Longrightarrow> t \<sqsubseteq> parallel_strategy (Src t)"
       by (induct t) auto
 
   end
 
   context reduction_paths
   begin
 
     text \<open>
      Parallel reduction is a universal strategy in the sense that every reduction path is
      \<open>\<^sup>*\<lesssim>\<^sup>*\<close>-below the path generated by the parallel reduction strategy.
     \<close>
 
     lemma parallel_strategy_is_universal:
-    shows "\<And>U. \<lbrakk>n > 0; n \<le> length U; Arr U\<rbrakk>
-                   \<Longrightarrow> take n U \<^sup>*\<lesssim>\<^sup>* apply_strategy \<Lambda>.parallel_strategy (Src U) n"
-    proof (induct n, simp)
+    shows "\<lbrakk>n > 0; n \<le> length U; Arr U\<rbrakk>
+              \<Longrightarrow> take n U \<^sup>*\<lesssim>\<^sup>* apply_strategy \<Lambda>.parallel_strategy (Src U) n"
+    proof (induct n arbitrary: U, simp)
       fix n a and U :: "\<Lambda>.lambda list"
       assume n: "Suc n \<le> length U"
       assume U: "Arr U"
       assume ind: "\<And>U. \<lbrakk>0 < n; n \<le> length U; Arr U\<rbrakk>
                           \<Longrightarrow> take n U \<^sup>*\<lesssim>\<^sup>* apply_strategy \<Lambda>.parallel_strategy (Src U) n"
       have 1: "take (Suc n) U = hd U # take n (tl U)"
         by (metis U Arr.simps(1) take_Suc)
       have 2: "hd U \<sqsubseteq> \<Lambda>.parallel_strategy (Src U)"
         by (metis Arr_imp_arr_hd Con_single_ideI(2) Resid_Arr_Src Src_resid Srcs_simp\<^sub>\<Lambda>\<^sub>P
             Trg.simps(2) U \<Lambda>.source_is_ide \<Lambda>.trg_ide empty_set \<Lambda>.arr_char \<Lambda>.sources_char\<^sub>\<Lambda>
             \<Lambda>.subs_parallel_strategy_Src list.set_intros(1) list.simps(15))
       show "take (Suc n) U \<^sup>*\<lesssim>\<^sup>* apply_strategy \<Lambda>.parallel_strategy (Src U) (Suc n)"
       proof (cases "apply_strategy \<Lambda>.parallel_strategy (Src U) (Suc n)")
         show "apply_strategy \<Lambda>.parallel_strategy (Src U) (Suc n) = [] \<Longrightarrow>
                 take (Suc n) U \<^sup>*\<lesssim>\<^sup>* apply_strategy \<Lambda>.parallel_strategy (Src U) (Suc n)"
           by simp
         fix v V
         assume 3: "apply_strategy \<Lambda>.parallel_strategy (Src U) (Suc n) = v # V"
         show "take (Suc n) U \<^sup>*\<lesssim>\<^sup>* apply_strategy \<Lambda>.parallel_strategy (Src U) (Suc n)"
         proof (cases "V = []")
           show "V = [] \<Longrightarrow> ?thesis"
             using 1 2 3 ind ide_char
             by (metis Suc_inject Ide.simps(2) Resid.simps(3) list.discI list.inject
                       \<Lambda>.prfx_implies_con apply_strategy.elims \<Lambda>.subs_implies_prfx take0)
           assume V: "V \<noteq> []"
           have 4: "Arr (v # V)"
             using 3 apply_strategy_gives_path(1)
             by (metis Arr_imp_arr_hd Srcs_simp\<^sub>P\<^sub>W\<^sub>E Srcs_simp\<^sub>\<Lambda>\<^sub>P U \<Lambda>.Ide_Src \<Lambda>.arr_iff_has_target
                 \<Lambda>.parallel_strategy_is_reduction_strategy \<Lambda>.targets_char\<^sub>\<Lambda> singleton_insert_inj_eq'
                 zero_less_Suc)
           have 5: "Arr (hd U # take n (tl U))"
             by (metis 1 U Arr_append_iff\<^sub>P id_take_nth_drop list.discI not_less take_all_iff)
           have 6: "Srcs (hd U # take n (tl U)) = Srcs (v # V)"
             by (metis 2 3 \<Lambda>.Coinitial_iff_Con \<Lambda>.Ide.simps(1) Srcs.simps(2) Srcs.simps(3)
                 \<Lambda>.ide_char list.exhaust_sel list.inject apply_strategy.simps(2) \<Lambda>.sources_char\<^sub>\<Lambda>
                 \<Lambda>.subs_implies_prfx)
           have "take (Suc n) U \<^sup>*\\\<^sup>* apply_strategy \<Lambda>.parallel_strategy (Src U) (Suc n) =
                 [hd U \\ v] \<^sup>*\\\<^sup>* V @ (take n (tl U) \<^sup>*\\\<^sup>* [v \\ hd U]) \<^sup>*\\\<^sup>* (V \<^sup>*\\\<^sup>* [hd U \\ v])"
             using U V 1 3 4 5 6
             by (metis Resid.simps(1) Resid_cons(1) Resid_rec(3-4) confluence_ind)
           moreover have "Ide ..."
           proof
             have 7: "v = \<Lambda>.parallel_strategy (Src U) \<and>
                       V = apply_strategy \<Lambda>.parallel_strategy (Src U \\ v) n"
               using 3 \<Lambda>.subs_implies_prfx \<Lambda>.subs_parallel_strategy_Src
               apply simp
               by (metis (full_types) \<Lambda>.Coinitial_iff_Con \<Lambda>.Ide.simps(1) \<Lambda>.Trg.simps(5)
                   \<Lambda>.parallel_strategy.simps(9) \<Lambda>.resid_Src_Arr)
             show 8: "Ide ([hd U \\ v] \<^sup>*\\\<^sup>* V)"
               by (metis 2 4 5 6 7 V Con_initial_left Ide.simps(2)
                   confluence_ind Con_rec(3) Resid_Ide_Arr_ind \<Lambda>.subs_implies_prfx)
             show 9: "Ide ((take n (tl U) \<^sup>*\\\<^sup>* [v \\ hd U]) \<^sup>*\\\<^sup>* (V \<^sup>*\\\<^sup>* [hd U \\ v]))"
             proof -
               have 10: "\<Lambda>.Ide (hd U \\ v)"
                 using 2 7 \<Lambda>.ide_char \<Lambda>.subs_implies_prfx by presburger
               have 11: "V = apply_strategy \<Lambda>.parallel_strategy (\<Lambda>.Trg v) n"
                 using 3 by auto
               have "(take n (tl U) \<^sup>*\\\<^sup>* [v \\ hd U]) \<^sup>*\\\<^sup>* (V \<^sup>*\\\<^sup>* [hd U \\ v]) =
                     (take n (tl U) \<^sup>*\\\<^sup>* [v \\ hd U]) \<^sup>*\\\<^sup>*
                        apply_strategy \<Lambda>.parallel_strategy (\<Lambda>.Trg v) n"
                 by (metis 8 10 11 Ide.simps(1) Resid_single_ide(2) \<Lambda>.prfx_char)
               moreover have "Ide ..."
               proof -
                 have "Ide (take n (take n (tl U) \<^sup>*\\\<^sup>* [v \\ hd U]) \<^sup>*\\\<^sup>*
                              apply_strategy \<Lambda>.parallel_strategy (\<Lambda>.Trg v) n)"
                 proof -
                   have "0 < n"
                   proof -
                     have "length V = n"
                       using apply_strategy_gives_path
                       by (metis 10 11 V \<Lambda>.Coinitial_iff_Con \<Lambda>.Ide_Trg \<Lambda>.Arr_not_Nil
                           \<Lambda>.Ide_implies_Arr \<Lambda>.parallel_strategy_is_reduction_strategy neq0_conv
                           apply_strategy.simps(1))
                     thus ?thesis
                       using V by blast
                   qed
                   moreover have "n \<le> length (take n (tl U) \<^sup>*\\\<^sup>* [v \\ hd U])"
                   proof -
                     have "length (take n (tl U)) = n"
                       using n by force
                     thus ?thesis
                       using n U length_Resid [of "take n (tl U)" "[v \\ hd U]"]
                       by (metis 4 5 6 Arr.simps(1) Con_cons(2) Con_rec(2)
                           confluence_ind dual_order.eq_iff)
                   qed
                   moreover have "\<Lambda>.Trg v = Src (take n (tl U) \<^sup>*\\\<^sup>* [v \\ hd U])"
                   proof -
                     have "Src (take n (tl U) \<^sup>*\\\<^sup>* [v \\ hd U]) = Trg [v \\ hd U]"
                       by (metis Src_resid calculation(1-2) linorder_not_less list.size(3))
                     also have "... = \<Lambda>.Trg v"
                       by (metis 10 Trg.simps(2) \<Lambda>.Arr_not_Nil \<Lambda>.apex_sym \<Lambda>.trg_ide
                           \<Lambda>.Ide_iff_Src_self \<Lambda>.Ide_implies_Arr \<Lambda>.Src_resid \<Lambda>.prfx_char)
                     finally show ?thesis by simp
                   qed
                   ultimately show ?thesis
                     using ind [of "Resid (take n (tl U)) [\<Lambda>.resid v (hd U)]"] ide_char
                     by (metis Con_imp_Arr_Resid le_zero_eq less_not_refl list.size(3))
                 qed
                 moreover have "take n (take n (tl U) \<^sup>*\\\<^sup>* [v \\ hd U]) =
                                take n (tl U) \<^sup>*\\\<^sup>* [v \\ hd U]"
                 proof -
                   have "Arr (take n (tl U) \<^sup>*\\\<^sup>* [v \\ hd U])"
                     by (metis Con_imp_Arr_Resid Con_implies_Arr(1) Ide.simps(1) calculation
                         take_Nil)
                   thus ?thesis
                     by (metis 1 Arr.simps(1) length_Resid dual_order.eq_iff length_Cons
                               length_take min.absorb2 n old.nat.inject take_all)
                 qed
                 ultimately show ?thesis by simp
               qed
               ultimately show ?thesis by auto
             qed
             show "Trg ([hd U \\ v] \<^sup>*\\\<^sup>* V) =
                   Src ((take n (tl U) \<^sup>*\\\<^sup>* [v \\ hd U]) \<^sup>*\\\<^sup>* (V \<^sup>*\\\<^sup>* [hd U \\ v]))"
               by (metis 9 Ide.simps(1) Src_resid Trg_resid_sym)
           qed
           ultimately show ?thesis
             using ide_char by presburger
         qed
       qed
     qed
 
   end
 
   context lambda_calculus
   begin
 
     text \<open>
       Parallel reduction is a normalizing strategy.
     \<close>
 
     lemma parallel_strategy_is_normalizing:
     shows "normalizing_strategy parallel_strategy"
     proof -
       interpret \<Lambda>x: reduction_paths .
       (* TODO: Notation is not inherited here. *)
       have "\<And>a. normalizable a \<Longrightarrow> \<exists>n. NF (reduce parallel_strategy a n)"
       proof -
         fix a
         assume 1: "normalizable a"
         obtain U b where U: "\<Lambda>x.Arr U \<and> \<Lambda>x.Src U = a \<and> \<Lambda>x.Trg U = b \<and> NF b"
           using 1 normalizable_def \<Lambda>x.red_iff by blast
         have 2: "\<And>n. \<lbrakk>0 < n; n \<le> length U\<rbrakk>
                         \<Longrightarrow> \<Lambda>x.Ide (\<Lambda>x.Resid (take n U) (\<Lambda>x.apply_strategy parallel_strategy a n))"
           using U \<Lambda>x.parallel_strategy_is_universal \<Lambda>x.ide_char by blast
         let ?PR = "\<Lambda>x.apply_strategy parallel_strategy a (length U)"
         have "\<Lambda>x.Trg ?PR = b"
         proof -
           have 3: "\<Lambda>x.Ide (\<Lambda>x.Resid U ?PR)"
             using U 2 [of "length U"] by force
           have "\<Lambda>x.Trg (\<Lambda>x.Resid ?PR U) = b"
             by (metis "3" NF_reduct_is_trivial U \<Lambda>x.Con_imp_Arr_Resid \<Lambda>x.Con_sym \<Lambda>x.Ide.simps(1)
                 \<Lambda>x.Src_resid reduction_paths.red_iff)
           thus ?thesis
             by (metis 3 \<Lambda>x.Con_Arr_self \<Lambda>x.Ide_implies_Arr \<Lambda>x.Resid_Arr_Ide_ind
                 \<Lambda>x.Src_resid \<Lambda>x.Trg_resid_sym)
         qed
         hence "reduce parallel_strategy a (length U) = b"
           using 1 U
           by (metis \<Lambda>x.Arr.simps(1) length_greater_0_conv normalizable_def
               \<Lambda>x.apply_strategy_gives_path(4) parallel_strategy_is_reduction_strategy)
         thus "\<exists>n. NF (reduce parallel_strategy a n)"
           using U by blast
       qed
       thus ?thesis
         using normalizing_strategy_def by blast
     qed
 
     text \<open>
       An alternative characterization of a normal form is a term on which the parallel
       reduction strategy yields an identity.
     \<close>
 
     abbreviation has_redex
     where "has_redex t \<equiv> Arr t \<and> \<not> Ide (parallel_strategy t)"
 
     lemma NF_iff_has_no_redex:
     shows "Arr t \<Longrightarrow> NF t \<longleftrightarrow> \<not> has_redex t"
     proof (induct t)
       show "Arr \<^bold>\<sharp> \<Longrightarrow> NF \<^bold>\<sharp> \<longleftrightarrow> \<not> has_redex \<^bold>\<sharp>"
         using NF_def by simp
       show "\<And>x. Arr \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<Longrightarrow> NF \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<longleftrightarrow> \<not> has_redex \<^bold>\<guillemotleft>x\<^bold>\<guillemotright>"
         using NF_def by force
       show "\<And>t. \<lbrakk>Arr t \<Longrightarrow> NF t \<longleftrightarrow> \<not> has_redex t; Arr \<^bold>\<lambda>\<^bold>[t\<^bold>]\<rbrakk> \<Longrightarrow> NF \<^bold>\<lambda>\<^bold>[t\<^bold>] \<longleftrightarrow> \<not> has_redex \<^bold>\<lambda>\<^bold>[t\<^bold>]"
       proof -
         fix t
         assume ind: "Arr t \<Longrightarrow> NF t \<longleftrightarrow> \<not> has_redex t"
         assume t: "Arr \<^bold>\<lambda>\<^bold>[t\<^bold>]"
         show "NF \<^bold>\<lambda>\<^bold>[t\<^bold>] \<longleftrightarrow> \<not> has_redex \<^bold>\<lambda>\<^bold>[t\<^bold>]"
         proof
           show "NF \<^bold>\<lambda>\<^bold>[t\<^bold>] \<Longrightarrow> \<not> has_redex \<^bold>\<lambda>\<^bold>[t\<^bold>]"
             using t ind
             by (metis NF_def Arr.simps(3) Ide.simps(3) Src.simps(3) parallel_strategy.simps(2))
           show "\<not> has_redex \<^bold>\<lambda>\<^bold>[t\<^bold>] \<Longrightarrow> NF \<^bold>\<lambda>\<^bold>[t\<^bold>]"
             using t ind
             by (metis NF_def ide_backward_stable ide_char parallel_strategy_Src_eq
                 subs_implies_prfx subs_parallel_strategy_Src)
         qed
       qed
       show "\<And>t1 t2. \<lbrakk>Arr t1 \<Longrightarrow> NF t1 \<longleftrightarrow> \<not> has_redex t1;
                      Arr t2 \<Longrightarrow> NF t2 \<longleftrightarrow> \<not> has_redex t2;
                      Arr (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)\<rbrakk>
                         \<Longrightarrow> NF (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) \<longleftrightarrow> \<not> has_redex (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)"
         using NF_def Ide.simps(5) parallel_strategy.simps(8) by presburger
       show "\<And>t1 t2. \<lbrakk>Arr t1 \<Longrightarrow> NF t1 \<longleftrightarrow> \<not> has_redex t1;
                      Arr t2 \<Longrightarrow> NF t2 \<longleftrightarrow> \<not> has_redex t2;
                      Arr (t1 \<^bold>\<circ> t2)\<rbrakk>
                         \<Longrightarrow> NF (t1 \<^bold>\<circ> t2) \<longleftrightarrow> \<not> has_redex (t1 \<^bold>\<circ> t2)"
       proof -
         fix t1 t2
         assume ind1: "Arr t1 \<Longrightarrow> NF t1 \<longleftrightarrow> \<not> has_redex t1"
         assume ind2: "Arr t2 \<Longrightarrow> NF t2 \<longleftrightarrow> \<not> has_redex t2"
         assume t: "Arr (t1 \<^bold>\<circ> t2)"
         show "NF (t1 \<^bold>\<circ> t2) \<longleftrightarrow> \<not> has_redex (t1 \<^bold>\<circ> t2)"
           using t ind1 ind2 NF_def
           apply (intro iffI)
            apply (metis Ide_iff_Src_self parallel_strategy_is_reduction_strategy
               reduction_strategy_def)
           apply (cases t1)
               apply simp_all
            apply (metis Ide_iff_Src_self ide_char parallel_strategy.simps(1,5)
               parallel_strategy_is_reduction_strategy reduction_strategy_def resid_Arr_Src
               subs_implies_prfx subs_parallel_strategy_Src)
           by (metis Ide_iff_Src_self ide_char ind1 Arr.simps(4) parallel_strategy.simps(6)
               parallel_strategy_is_reduction_strategy reduction_strategy_def resid_Arr_Src
               subs_implies_prfx subs_parallel_strategy_Src)
       qed
     qed
 
     lemma (in lambda_calculus) not_NF_elim:
     assumes "\<not> NF t" and "Ide t"
     obtains u where "coinitial t u \<and> \<not> Ide u"
       using assms NF_def by auto
 
     lemma (in lambda_calculus) NF_Lam_iff:
     shows "NF \<^bold>\<lambda>\<^bold>[t\<^bold>] \<longleftrightarrow> NF t"
       using NF_def
       by (metis Ide_implies_Arr NF_iff_has_no_redex Ide.simps(3) parallel_strategy.simps(2))
 
     lemma (in lambda_calculus) NF_App_iff:
     shows "NF (t1 \<^bold>\<circ> t2) \<longleftrightarrow> \<not> is_Lam t1 \<and> NF t1 \<and> NF t2"
     proof -
       have "\<not> NF (t1 \<^bold>\<circ> t2) \<Longrightarrow> is_Lam t1 \<or> \<not> NF t1 \<or> \<not> NF t2"
         apply (cases "is_Lam t1")
          apply simp_all
         apply (cases t1)
             apply simp_all
         using NF_def Ide.simps(1) apply presburger
           apply (metis Ide_implies_Arr NF_def NF_iff_has_no_redex Ide.simps(4)
             parallel_strategy.simps(5))
         apply (metis Ide_implies_Arr NF_def NF_iff_has_no_redex Ide.simps(4)
             parallel_strategy.simps(6))
         using NF_def Ide.simps(5) by presburger
       moreover have "is_Lam t1 \<or> \<not> NF t1 \<or> \<not> NF t2 \<Longrightarrow> \<not> NF (t1 \<^bold>\<circ> t2)"
       proof -
         have "is_Lam t1 \<Longrightarrow> \<not>NF (t1 \<^bold>\<circ> t2)"
           by (metis Ide_implies_Arr NF_def NF_iff_has_no_redex Ide.simps(5) lambda.collapse(2)
               parallel_strategy.simps(3,8))
         moreover have "\<not> NF t1 \<Longrightarrow> \<not>NF (t1 \<^bold>\<circ> t2)"
           using NF_def Ide_iff_Src_self Ide_implies_Arr
           apply auto
           by (metis (full_types) Arr.simps(4) Ide.simps(4) Src.simps(4))
         moreover have "\<not> NF t2 \<Longrightarrow> \<not>NF (t1 \<^bold>\<circ> t2)"
           using NF_def Ide_iff_Src_self Ide_implies_Arr
           apply auto
           by (metis (full_types) Arr.simps(4) Ide.simps(4) Src.simps(4))
         ultimately show "is_Lam t1 \<or> \<not> NF t1 \<or> \<not> NF t2 \<Longrightarrow> \<not> NF (t1 \<^bold>\<circ> t2)"
           by auto
       qed
       ultimately show ?thesis by blast
     qed
 
     subsection "Head Reduction"
 
     text \<open>
       \emph{Head reduction} is the strategy that only contracts a redex at the ``head'' position,
       which is found at the end of the ``left spine'' of applications, and does nothing if there is
       no such redex.
 
       The following function applies to an arbitrary arrow \<open>t\<close>, and it marks the redex at
       the head position, if any, otherwise it yields \<open>Src t\<close>.
     \<close>
 
     fun head_strategy
     where "head_strategy \<^bold>\<guillemotleft>i\<^bold>\<guillemotright> = \<^bold>\<guillemotleft>i\<^bold>\<guillemotright>"
         | "head_strategy \<^bold>\<lambda>\<^bold>[t\<^bold>] = \<^bold>\<lambda>\<^bold>[head_strategy t\<^bold>]"
         | "head_strategy (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<circ> u) = \<^bold>\<lambda>\<^bold>[Src t\<^bold>] \<^bold>\<Zspot> Src u"
         | "head_strategy (t \<^bold>\<circ> u) = head_strategy t \<^bold>\<circ> Src u"
         | "head_strategy (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) = \<^bold>\<lambda>\<^bold>[Src t\<^bold>] \<^bold>\<Zspot> Src u"
         | "head_strategy \<^bold>\<sharp> = \<^bold>\<sharp>"
 
     lemma Arr_head_strategy:
     shows "Arr t \<Longrightarrow> Arr (head_strategy t)"
       apply (induct t)
           apply auto
     proof -
       fix t u
       assume ind: "Arr (head_strategy t)"
       assume t: "Arr t" and u: "Arr u"
       show "Arr (head_strategy (t \<^bold>\<circ> u))"
         using t u ind
         by (cases t) auto
     qed
 
     lemma Src_head_strategy:
     shows "Arr t \<Longrightarrow> Src (head_strategy t) = Src t"
       apply (induct t)
           apply auto
     proof -
       fix t u
       assume ind: "Src (head_strategy t) = Src t"
       assume t: "Arr t" and u: "Arr u"
       have "Src (head_strategy (t \<^bold>\<circ> u)) = Src (head_strategy t \<^bold>\<circ> Src u)"
         using t ind
         by (cases t) auto
       also have "... = Src t \<^bold>\<circ> Src u"
         using t u ind by auto
       finally show "Src (head_strategy (t \<^bold>\<circ> u)) = Src t \<^bold>\<circ> Src u" by simp
     qed
 
     lemma Con_head_strategy:
     shows "Arr t \<Longrightarrow> Con t (head_strategy t)"
       apply (induct t)
           apply auto
        apply (simp add: Arr_head_strategy Src_head_strategy)
       using Arr_Subst Arr_not_Nil by auto
 
     lemma head_strategy_Src:
     shows "Arr t \<Longrightarrow> head_strategy (Src t) = head_strategy t"
       apply (induct t)
           apply auto
       using Arr.elims(2) by fastforce
 
     lemma head_strategy_is_elementary:
     shows "\<lbrakk>Arr t; \<not> Ide (head_strategy t)\<rbrakk> \<Longrightarrow> elementary_reduction (head_strategy t)"
       using Ide_Src
       apply (induct t)
           apply auto
     proof -
       fix t1 t2
       assume t1: "Arr t1" and t2: "Arr t2"
       assume t: "\<not> Ide (head_strategy (t1 \<^bold>\<circ> t2))"
       assume 1: "\<not> Ide (head_strategy t1) \<Longrightarrow> elementary_reduction (head_strategy t1)"
       assume 2: "\<not> Ide (head_strategy t2) \<Longrightarrow> elementary_reduction (head_strategy t2)"
       show "elementary_reduction (head_strategy (t1 \<^bold>\<circ> t2))"
         using t t1 t2 1 2 Ide_Src Ide_implies_Arr
         by (cases t1) auto
     qed
 
     lemma head_strategy_is_reduction_strategy:
     shows "reduction_strategy head_strategy"
     proof (unfold reduction_strategy_def, intro allI impI)
       fix t
       show "Ide t \<Longrightarrow> Coinitial (head_strategy t) t"
       proof (induct t)
         show "Ide \<^bold>\<sharp> \<Longrightarrow> Coinitial (head_strategy \<^bold>\<sharp>) \<^bold>\<sharp>"
           by simp
         show "\<And>x. Ide \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<Longrightarrow> Coinitial (head_strategy \<^bold>\<guillemotleft>x\<^bold>\<guillemotright>) \<^bold>\<guillemotleft>x\<^bold>\<guillemotright>"
           by simp
         show "\<And>t. \<lbrakk>Ide t \<Longrightarrow> Coinitial (head_strategy t) t; Ide \<^bold>\<lambda>\<^bold>[t\<^bold>]\<rbrakk>
                       \<Longrightarrow> Coinitial (head_strategy \<^bold>\<lambda>\<^bold>[t\<^bold>]) \<^bold>\<lambda>\<^bold>[t\<^bold>]"
           by simp
         fix t1 t2
           assume ind1: "Ide t1 \<Longrightarrow> Coinitial (head_strategy t1) t1"
         assume ind2: "Ide t2 \<Longrightarrow> Coinitial (head_strategy t2) t2"
         assume t: "Ide (t1 \<^bold>\<circ> t2)"
         show "Coinitial (head_strategy (t1 \<^bold>\<circ> t2)) (t1 \<^bold>\<circ> t2)"
           using t ind1 Ide_implies_Arr Ide_iff_Src_self
           by (cases t1) simp_all
         next
         fix t1 t2
         assume ind1: "Ide t1 \<Longrightarrow> Coinitial (head_strategy t1) t1"
         assume ind2: "Ide t2 \<Longrightarrow> Coinitial (head_strategy t2) t2"
         assume t: "Ide (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)"
         show "Coinitial (head_strategy (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)) (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)"
           using t by auto
       qed
     qed
 
     text \<open>
       The following function tests whether a term is an elementary reduction of the head redex.
     \<close>
 
     fun is_head_reduction
     where "is_head_reduction \<^bold>\<guillemotleft>_\<^bold>\<guillemotright> \<longleftrightarrow> False"
         | "is_head_reduction \<^bold>\<lambda>\<^bold>[t\<^bold>] \<longleftrightarrow> is_head_reduction t"
         | "is_head_reduction (\<^bold>\<lambda>\<^bold>[_\<^bold>] \<^bold>\<circ> _) \<longleftrightarrow> False"
         | "is_head_reduction (t \<^bold>\<circ> u) \<longleftrightarrow> is_head_reduction t \<and> Ide u"
         | "is_head_reduction (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) \<longleftrightarrow> Ide t \<and> Ide u"
         | "is_head_reduction \<^bold>\<sharp> \<longleftrightarrow> False"
 
     lemma is_head_reduction_char:
     shows "is_head_reduction t \<longleftrightarrow> elementary_reduction t \<and> head_strategy (Src t) = t"
       apply (induct t)
           apply simp_all
     proof -
       fix t1 t2
       assume ind: "is_head_reduction t1 \<longleftrightarrow>
                    elementary_reduction t1 \<and> head_strategy (Src t1) = t1"
       show "is_head_reduction (t1 \<^bold>\<circ> t2) \<longleftrightarrow>
              (elementary_reduction t1 \<and> Ide t2 \<or> Ide t1 \<and> elementary_reduction t2) \<and>
               head_strategy (Src t1 \<^bold>\<circ> Src t2) = t1 \<^bold>\<circ> t2"
         using ind Ide_implies_Arr Ide_iff_Src_self Ide_Src elementary_reduction_not_ide
               ide_char
         apply (cases t1)
             apply simp_all
           apply (metis Ide_Src arr_char elementary_reduction_is_arr)
          apply (metis Ide_Src arr_char elementary_reduction_is_arr)
         by metis
       next
       fix t1 t2
       show "Ide t1 \<and> Ide t2 \<longleftrightarrow> Ide t1 \<and> Ide t2 \<and> Src (Src t1) = t1 \<and> Src (Src t2) = t2"
         by (metis Ide_iff_Src_self Ide_implies_Arr)
     qed
 
     lemma is_head_reductionI:
     assumes "Arr t" and "elementary_reduction t" and "head_strategy (Src t) = t"
     shows "is_head_reduction t"
       using assms is_head_reduction_char by blast
 
     text \<open>
       The following function tests whether a redex in the head position of a term is marked.
     \<close>
 
     fun contains_head_reduction
     where "contains_head_reduction \<^bold>\<guillemotleft>_\<^bold>\<guillemotright> \<longleftrightarrow> False"
         | "contains_head_reduction \<^bold>\<lambda>\<^bold>[t\<^bold>] \<longleftrightarrow> contains_head_reduction t"
         | "contains_head_reduction (\<^bold>\<lambda>\<^bold>[_\<^bold>] \<^bold>\<circ> _) \<longleftrightarrow> False"
         | "contains_head_reduction (t \<^bold>\<circ> u) \<longleftrightarrow> contains_head_reduction t \<and> Arr u"
         | "contains_head_reduction (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) \<longleftrightarrow> Arr t \<and> Arr u"
         | "contains_head_reduction \<^bold>\<sharp> \<longleftrightarrow> False"
 
     lemma is_head_reduction_imp_contains_head_reduction:
     shows "is_head_reduction t \<Longrightarrow> contains_head_reduction t"
       using Ide_implies_Arr
       apply (induct t)
           apply auto
     proof -
       fix t1 t2
       assume ind1: "is_head_reduction t1 \<Longrightarrow> contains_head_reduction t1"
       assume ind2: "is_head_reduction t2 \<Longrightarrow> contains_head_reduction t2"
       assume t: "is_head_reduction (t1 \<^bold>\<circ> t2)"
       show "contains_head_reduction (t1 \<^bold>\<circ> t2)"
         using t ind1 ind2 Ide_implies_Arr
         by (cases t1) auto
     qed
 
     text \<open>
       An \emph{internal reduction} is one that does not contract any redex at the head position.
     \<close>
 
     fun is_internal_reduction
     where "is_internal_reduction \<^bold>\<guillemotleft>_\<^bold>\<guillemotright> \<longleftrightarrow> True"
         | "is_internal_reduction \<^bold>\<lambda>\<^bold>[t\<^bold>] \<longleftrightarrow> is_internal_reduction t"
         | "is_internal_reduction (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<circ> u) \<longleftrightarrow> Arr t \<and> Arr u"
         | "is_internal_reduction (t \<^bold>\<circ> u) \<longleftrightarrow> is_internal_reduction t \<and> Arr u"
         | "is_internal_reduction (\<^bold>\<lambda>\<^bold>[_\<^bold>] \<^bold>\<Zspot> _) \<longleftrightarrow> False"
         | "is_internal_reduction \<^bold>\<sharp> \<longleftrightarrow> False"
 
     lemma is_internal_reduction_iff:
     shows "is_internal_reduction t \<longleftrightarrow> Arr t \<and> \<not> contains_head_reduction t"
       apply (induct t)
           apply simp_all
     proof -
       fix t1 t2
       assume ind1: "is_internal_reduction t1 \<longleftrightarrow> Arr t1 \<and> \<not> contains_head_reduction t1"
       assume ind2: "is_internal_reduction t2 \<longleftrightarrow> Arr t2 \<and> \<not> contains_head_reduction t2"
       show "is_internal_reduction (t1 \<^bold>\<circ> t2) \<longleftrightarrow>
             Arr t1 \<and> Arr t2 \<and> \<not> contains_head_reduction (t1 \<^bold>\<circ> t2)"
         using ind1 ind2
         apply (cases t1)
             apply simp_all
         by blast
     qed
 
     text \<open>
       Head reduction steps are either \<open>\<lesssim>\<close>-prefixes of, or are preserved by, residuation along
       arbitrary reductions.
     \<close>
 
     lemma is_head_reduction_resid:
-    shows "\<And>u. \<lbrakk>is_head_reduction t; Arr u; Src t = Src u\<rbrakk>
-                  \<Longrightarrow> t \<lesssim> u \<or> is_head_reduction (t \\ u)"
-    proof (induct t)
+    shows "\<lbrakk>is_head_reduction t; Arr u; Src t = Src u\<rbrakk> \<Longrightarrow> t \<lesssim> u \<or> is_head_reduction (t \\ u)"
+    proof (induct t arbitrary: u)
       show "\<And>u. \<lbrakk>is_head_reduction \<^bold>\<sharp>; Arr u; Src \<^bold>\<sharp> = Src u\<rbrakk>
                    \<Longrightarrow> \<^bold>\<sharp> \<lesssim> u \<or> is_head_reduction (\<^bold>\<sharp> \\ u)"
         by auto
       show "\<And>x u. \<lbrakk>is_head_reduction \<^bold>\<guillemotleft>x\<^bold>\<guillemotright>; Arr u; Src \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> = Src u\<rbrakk>
                      \<Longrightarrow> \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<lesssim> u \<or> is_head_reduction (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \\ u)"
         by auto
       fix t u
       assume ind: "\<And>u. \<lbrakk>is_head_reduction t; Arr u; Src t = Src u\<rbrakk>
                           \<Longrightarrow> t \<lesssim> u \<or> is_head_reduction (t \\ u)"
       assume t: "is_head_reduction \<^bold>\<lambda>\<^bold>[t\<^bold>]"
       assume u: "Arr u"
       assume tu: "Src \<^bold>\<lambda>\<^bold>[t\<^bold>] = Src u"
       have 1: "Arr t"
         by (metis Arr_head_strategy head_strategy_Src is_head_reduction_char Arr.simps(3) t tu u)
       show " \<^bold>\<lambda>\<^bold>[t\<^bold>] \<lesssim> u \<or> is_head_reduction (\<^bold>\<lambda>\<^bold>[t\<^bold>] \\ u)"
         using t u tu 1 ind
         by (cases u) auto
       next
       fix t1 t2 u
       assume ind1: "\<And>u1. \<lbrakk>is_head_reduction t1; Arr u1; Src t1 = Src u1\<rbrakk>
                            \<Longrightarrow> t1 \<lesssim> u1 \<or> is_head_reduction (t1 \\ u1)"
       assume ind2: "\<And>u2. \<lbrakk>is_head_reduction t2; Arr u2; Src t2 = Src u2\<rbrakk>
                            \<Longrightarrow> t2 \<lesssim> u2 \<or> is_head_reduction (t2 \\ u2)"
       assume t: "is_head_reduction (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)"
       assume u: "Arr u"
       assume tu: "Src (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) = Src u"
       show "\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2 \<lesssim> u \<or> is_head_reduction ((\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) \\ u)"
         using t u tu ind1 ind2 Coinitial_iff_Con Ide_implies_Arr ide_char resid_Ide_Arr Ide_Subst
         by (cases u; cases "un_App1 u") auto
       next
       fix t1 t2 u
       assume ind1: "\<And>u1. \<lbrakk>is_head_reduction t1; Arr u1; Src t1 = Src u1\<rbrakk>
                            \<Longrightarrow> t1 \<lesssim> u1 \<or> is_head_reduction (t1 \\ u1)"
       assume ind2: "\<And>u2. \<lbrakk>is_head_reduction t2; Arr u2; Src t2 = Src u2\<rbrakk>
                            \<Longrightarrow> t2 \<lesssim> u2 \<or> is_head_reduction (t2 \\ u2)"
       assume t: "is_head_reduction (t1 \<^bold>\<circ> t2)"
       assume u: "Arr u"
       assume tu: "Src (t1 \<^bold>\<circ> t2) = Src u"
       have "Arr (t1 \<^bold>\<circ> t2)"
         using is_head_reduction_char elementary_reduction_is_arr t by blast
       hence t1: "Arr t1" and t2: "Arr t2"
         by auto
       have 0: "\<not> is_Lam t1"
         using t is_Lam_def by fastforce
       have 1: "is_head_reduction t1"
         using t t1 by force
       show "t1 \<^bold>\<circ> t2 \<lesssim> u \<or> is_head_reduction ((t1 \<^bold>\<circ> t2) \\ u) "
       proof -
         have "\<not> Ide ((t1 \<^bold>\<circ> t2) \\ u) \<Longrightarrow> is_head_reduction ((t1 \<^bold>\<circ> t2) \\ u)"
         proof (intro is_head_reductionI)
           assume 2: "\<not> Ide ((t1 \<^bold>\<circ> t2) \\ u)"
           have 3: "is_App u \<Longrightarrow> \<not> Ide (t1 \\ un_App1 u) \<or> \<not> Ide (t2 \\ un_App2 u)"
             by (metis "2" ide_char lambda.collapse(3) lambda.discI(3) lambda.sel(3-4) prfx_App_iff)
           have 4: "is_Beta u \<Longrightarrow> \<not> Ide (t1 \\ un_Beta1 u) \<or> \<not> Ide (t2 \\ un_Beta2 u)"
             using u tu 2
             by (metis "0" ConI Con_implies_is_Lam_iff_is_Lam \<open>Arr (t1 \<^bold>\<circ> t2)\<close>
                 ConD(4) lambda.collapse(4) lambda.disc(8))
           show 5: "Arr ((t1 \<^bold>\<circ> t2) \\ u)"
             using Arr_resid \<open>Arr (t1 \<^bold>\<circ> t2)\<close> tu u by auto
           show "head_strategy (Src ((t1 \<^bold>\<circ> t2) \\ u)) = (t1 \<^bold>\<circ> t2) \\ u"
           proof (cases u)
             show "u = \<^bold>\<sharp> \<Longrightarrow> head_strategy (Src ((t1 \<^bold>\<circ> t2) \\ u)) = (t1 \<^bold>\<circ> t2) \\ u"
               by simp
             show "\<And>x. u = \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<Longrightarrow> head_strategy (Src ((t1 \<^bold>\<circ> t2) \\ u)) = (t1 \<^bold>\<circ> t2) \\ u"
               by auto
             show "\<And>v. u = \<^bold>\<lambda>\<^bold>[v\<^bold>] \<Longrightarrow> head_strategy (Src ((t1 \<^bold>\<circ> t2) \\ u)) = (t1 \<^bold>\<circ> t2) \\ u"
               by simp
             show "\<And>u1 u2. u = \<^bold>\<lambda>\<^bold>[u1\<^bold>] \<^bold>\<Zspot> u2 \<Longrightarrow> head_strategy (Src ((t1 \<^bold>\<circ> t2) \\ u)) = (t1 \<^bold>\<circ> t2) \\ u"
               by (metis "0" "5" Arr_not_Nil ConD(4) Con_implies_is_Lam_iff_is_Lam lambda.disc(8))
             show "\<And>u1 u2. u = App u1 u2 \<Longrightarrow> head_strategy (Src ((t1 \<^bold>\<circ> t2) \\ u)) = (t1 \<^bold>\<circ> t2) \\ u"
             proof -
               fix u1 u2
               assume u1u2: "u = u1 \<^bold>\<circ> u2"
               have "head_strategy (Src ((t1 \<^bold>\<circ> t2) \\ u)) =
                     head_strategy (Src (t1 \\ u1) \<^bold>\<circ> Src (t2 \\ u2))"
                 using u u1u2 tu t1 t2 Coinitial_iff_Con by auto
               also have "... = head_strategy (Trg u1 \<^bold>\<circ> Trg u2)"
                 using 5 u1u2 Src_resid
                 by (metis Arr_not_Nil ConD(1))
               also have "... = (t1 \<^bold>\<circ> t2) \\ u"
               proof (cases "Trg u1")
                 show "Trg u1 = \<^bold>\<sharp> \<Longrightarrow> head_strategy (Trg u1 \<^bold>\<circ> Trg u2) = (t1 \<^bold>\<circ> t2) \\ u"
                   using Arr_not_Nil u u1u2 by force
                 show "\<And>x. Trg u1 = \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<Longrightarrow> head_strategy (Trg u1 \<^bold>\<circ> Trg u2) = (t1 \<^bold>\<circ> t2) \\ u"
                   using tu t u t1 t2 u1u2 Arr_not_Nil Ide_iff_Src_self
                   by (cases u1; cases t1) auto
                 show "\<And>v. Trg u1 = \<^bold>\<lambda>\<^bold>[v\<^bold>] \<Longrightarrow> head_strategy (Trg u1 \<^bold>\<circ> Trg u2) = (t1 \<^bold>\<circ> t2) \\ u"
                   using tu t u t1 t2 u1u2 Arr_not_Nil Ide_iff_Src_self
                   apply (cases u1; cases t1)
                                       apply auto
                   by (metis 2 5 Src_resid Trg.simps(3-4) resid.simps(3-4) resid_Src_Arr)
                 show "\<And>u11 u12. Trg u1 = u11 \<^bold>\<circ> u12
                                    \<Longrightarrow> head_strategy (Trg u1 \<^bold>\<circ> Trg u2) = (t1 \<^bold>\<circ> t2) \\ u"
                 proof -
                   fix u11 u12
                   assume u1: "Trg u1 = u11 \<^bold>\<circ> u12"
                   show "head_strategy (Trg u1 \<^bold>\<circ> Trg u2) = (t1 \<^bold>\<circ> t2) \\ u"
                   proof (cases "Trg u1")
                     show "Trg u1 = \<^bold>\<sharp> \<Longrightarrow> ?thesis"
                       using u1 by simp
                     show "\<And>x. Trg u1 = \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<Longrightarrow> ?thesis"
                       apply simp
                       using u1 by force
                     show "\<And>v. Trg u1 = \<^bold>\<lambda>\<^bold>[v\<^bold>] \<Longrightarrow> ?thesis"
                       using u1 by simp
                     show "\<And>u11 u12. Trg u1 = u11 \<^bold>\<circ> u12 \<Longrightarrow> ?thesis"
                       using t u tu u1u2 1 2 ind1 elementary_reduction_not_ide
                             is_head_reduction_char Src_resid Ide_iff_Src_self
                             \<open>Arr (t1 \<^bold>\<circ> t2)\<close> Coinitial_iff_Con
                       by fastforce
                     show "\<And>u11 u12. Trg u1 = \<^bold>\<lambda>\<^bold>[u11\<^bold>] \<^bold>\<Zspot> u12 \<Longrightarrow> ?thesis"
                       using u1 by simp
                   qed
                 qed
                 show "\<And>u11 u12. Trg u1 = \<^bold>\<lambda>\<^bold>[u11\<^bold>] \<^bold>\<Zspot> u12 \<Longrightarrow> ?thesis"
                   using u1u2 u Ide_Trg by fastforce
               qed
               finally show "head_strategy (Src ((t1 \<^bold>\<circ> t2) \\ u)) = (t1 \<^bold>\<circ> t2) \\ u"
                 by simp
             qed
           qed
           thus "elementary_reduction ((t1 \<^bold>\<circ> t2) \\ u)"
             by (metis 2 5 Ide_Src Ide_implies_Arr head_strategy_is_elementary)
         qed
         thus ?thesis by blast
       qed
     qed
 
     text \<open>
        Internal reductions are closed under residuation.
     \<close>
 
     lemma is_internal_reduction_resid:
-    shows "\<And>u. \<lbrakk>is_internal_reduction t; is_internal_reduction u; Src t = Src u\<rbrakk>
-                  \<Longrightarrow> is_internal_reduction (t \\ u)"
-      apply (induct t)
+    shows "\<lbrakk>is_internal_reduction t; is_internal_reduction u; Src t = Src u\<rbrakk>
+              \<Longrightarrow> is_internal_reduction (t \\ u)"
+      apply (induct t arbitrary: u)
           apply auto
       apply (metis Con_implies_Arr2 con_char weak_extensionality Arr.simps(2) Src.simps(2)
                    parallel_strategy.simps(1) prfx_implies_con resid_Arr_Src subs_Ide
                    subs_implies_prfx subs_parallel_strategy_Src)
     proof -
       fix t u
       assume ind: "\<And>u. \<lbrakk>is_internal_reduction u; Src t = Src u\<rbrakk> \<Longrightarrow> is_internal_reduction (t \\ u)"
       assume t: "is_internal_reduction t"
       assume u: "is_internal_reduction u"
       assume tu: "\<^bold>\<lambda>\<^bold>[Src t\<^bold>] = Src u"
       show "is_internal_reduction (\<^bold>\<lambda>\<^bold>[t\<^bold>] \\ u)"
         using t u tu ind
         apply (cases u)
         by auto fastforce
       next
       fix t1 t2 u
       assume ind1: "\<And>u. \<lbrakk>is_internal_reduction t1; is_internal_reduction u; Src t1 = Src u\<rbrakk>
                             \<Longrightarrow> is_internal_reduction (t1 \\ u)"
       assume t: "is_internal_reduction (t1 \<^bold>\<circ> t2)"
       assume u: "is_internal_reduction u"
       assume tu: "Src t1 \<^bold>\<circ> Src t2 = Src u"
       show "is_internal_reduction ((t1 \<^bold>\<circ> t2) \\ u)"
         using t u tu ind1 Coinitial_resid_resid Coinitial_iff_Con Arr_Src
               is_internal_reduction_iff
         apply auto
          apply (metis Arr.simps(4) Src.simps(4))
       proof -
         assume t1: "Arr t1" and t2: "Arr t2" and u: "Arr u"
         assume tu: "Src t1 \<^bold>\<circ> Src t2 = Src u"
         assume 1: "\<not> contains_head_reduction u"
         assume 2: "\<not> contains_head_reduction (t1 \<^bold>\<circ> t2)"
         assume 3: "contains_head_reduction ((t1 \<^bold>\<circ> t2) \\ u)"
         show False
           using t1 t2 u tu 1 2 3 is_internal_reduction_iff
           apply (cases u)
               apply simp_all
           apply (cases t1; cases "un_App1 u")
                               apply simp_all
           by (metis Coinitial_iff_Con ind1 Arr.simps(4) Src.simps(4) resid.simps(3))
       qed
     qed
 
     text \<open>
       A head reduction is preserved by residuation along an internal reduction,
       so a head reduction can only be canceled by a transition that contains a head reduction.
     \<close>
 
     lemma is_head_reduction_resid':
-    shows "\<And>u. \<lbrakk>is_head_reduction t; is_internal_reduction u; Src t = Src u\<rbrakk>
-                   \<Longrightarrow> is_head_reduction (t \\ u)"
-    proof (induct t)
+    shows "\<lbrakk>is_head_reduction t; is_internal_reduction u; Src t = Src u\<rbrakk>
+               \<Longrightarrow> is_head_reduction (t \\ u)"
+    proof (induct t arbitrary: u)
       show "\<And>u. \<lbrakk>is_head_reduction \<^bold>\<sharp>; is_internal_reduction u; Src \<^bold>\<sharp> = Src u\<rbrakk>
                    \<Longrightarrow> is_head_reduction (\<^bold>\<sharp> \\ u)"
         by simp
       show "\<And>x u. \<lbrakk>is_head_reduction \<^bold>\<guillemotleft>x\<^bold>\<guillemotright>; is_internal_reduction u; Src \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> = Src u\<rbrakk>
                      \<Longrightarrow> is_head_reduction (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \\ u)"
         by simp
       show "\<And>t. \<lbrakk>\<And>u. \<lbrakk>is_head_reduction t; is_internal_reduction u; Src t = Src u\<rbrakk>
                          \<Longrightarrow> is_head_reduction (t \\ u);
                        is_head_reduction \<^bold>\<lambda>\<^bold>[t\<^bold>]; is_internal_reduction u; Src \<^bold>\<lambda>\<^bold>[t\<^bold>] = Src u\<rbrakk>
                     \<Longrightarrow> is_head_reduction (\<^bold>\<lambda>\<^bold>[t\<^bold>] \\ u)"
         for u
         by (cases u, simp_all) fastforce
       fix t1 t2 u
       assume ind1: "\<And>u. \<lbrakk>is_head_reduction t1; is_internal_reduction u; Src t1 = Src u\<rbrakk>
                             \<Longrightarrow> is_head_reduction (t1 \\ u)"
       assume t: "is_head_reduction (t1 \<^bold>\<circ> t2)"
       assume u: "is_internal_reduction u"
       assume tu: "Src (t1 \<^bold>\<circ> t2) = Src u"
       show "is_head_reduction ((t1 \<^bold>\<circ> t2) \\ u)"
         using t u tu ind1
         apply (cases u)
            apply simp_all
       proof (intro conjI impI)
         fix u1 u2
         assume u1u2: "u = u1 \<^bold>\<circ> u2"
         show 1: "Con t1 u1"
           using Coinitial_iff_Con tu u1u2 ide_char
           by (metis ConD(1) Ide.simps(1) is_head_reduction.simps(9) is_head_reduction_resid
               is_internal_reduction.simps(9) is_internal_reduction_resid t u)
         show "Con t2 u2"
           using Coinitial_iff_Con tu u1u2 ide_char
           by (metis ConD(1) Ide.simps(1) is_head_reduction.simps(9) is_head_reduction_resid
               is_internal_reduction.simps(9) is_internal_reduction_resid t u)
         show "is_head_reduction (t1 \\ u1 \<^bold>\<circ> t2 \\ u2)"
           using t u u1u2 1 Coinitial_iff_Con \<open>Con t2 u2\<close> ide_char ind1 resid_Ide_Arr
           apply (cases t1; simp_all; cases u1; simp_all; cases "un_App1 u1")
                    apply auto
           by (metis 1 ind1 is_internal_reduction.simps(6) resid.simps(3))
       qed
       next
       fix t1 t2 u
       assume ind1: "\<And>u. \<lbrakk>is_head_reduction t1; is_internal_reduction u; Src t1 = Src u\<rbrakk>
                             \<Longrightarrow> is_head_reduction (t1 \\ u)"
       assume t: "is_head_reduction (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)"
       assume u: "is_internal_reduction u"
       assume tu: "Src (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) = Src u"
       show "is_head_reduction ((\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) \\ u)"
         using t u tu ind1
         apply (cases u)
             apply simp_all
         by (metis Con_implies_Arr1 is_head_reduction_resid is_internal_reduction.simps(9)
             is_internal_reduction_resid lambda.disc(15) prfx_App_iff t tu)
     qed
 
     text \<open>
       The following function differs from \<open>head_strategy\<close> in that it only selects an already-marked
       redex, whereas \<open>head_strategy\<close> marks the redex at the head position.
     \<close>
 
     fun head_redex
     where "head_redex \<^bold>\<sharp> = \<^bold>\<sharp>"
         | "head_redex \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> = \<^bold>\<guillemotleft>x\<^bold>\<guillemotright>"
         | "head_redex \<^bold>\<lambda>\<^bold>[t\<^bold>] = \<^bold>\<lambda>\<^bold>[head_redex t\<^bold>]"
         | "head_redex (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<circ> u) = \<^bold>\<lambda>\<^bold>[Src t\<^bold>] \<^bold>\<circ> Src u"
         | "head_redex (t \<^bold>\<circ> u) = head_redex t \<^bold>\<circ> Src u"
         | "head_redex (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) = (\<^bold>\<lambda>\<^bold>[Src t\<^bold>] \<^bold>\<Zspot> Src u)"
 
     lemma elementary_reduction_head_redex:
     shows "\<lbrakk>Arr t; \<not> Ide (head_redex t)\<rbrakk> \<Longrightarrow> elementary_reduction (head_redex t)"
       using Ide_Src
       apply (induct t)
           apply auto
     proof -
       show "\<And>t2. \<lbrakk>\<not> Ide (head_redex t1) \<Longrightarrow> elementary_reduction (head_redex t1);
                   \<not> Ide (head_redex (t1 \<^bold>\<circ> t2));
                   \<And>t. Arr t \<Longrightarrow> Ide (Src t); Arr t1; Arr t2\<rbrakk>
                      \<Longrightarrow> elementary_reduction (head_redex (t1 \<^bold>\<circ> t2))"
         for t1
         using Ide_Src
         by (cases t1) auto
     qed
 
     lemma subs_head_redex:
     shows "Arr t \<Longrightarrow> head_redex t \<sqsubseteq> t"
       using Ide_Src subs_Ide
       apply (induct t)
           apply simp_all
     proof -
       show "\<And>t2. \<lbrakk>head_redex t1 \<sqsubseteq> t1; head_redex t2 \<sqsubseteq> t2;
                   Arr t1 \<and> Arr t2; \<And>t. Arr t \<Longrightarrow> Ide (Src t);
                   \<And>u t. \<lbrakk>Ide u; Src t = Src u\<rbrakk> \<Longrightarrow> u \<sqsubseteq> t\<rbrakk>
                     \<Longrightarrow> head_redex (t1 \<^bold>\<circ> t2) \<sqsubseteq> t1 \<^bold>\<circ> t2"
         for t1
         using Ide_Src subs_Ide
         by (cases t1) auto
     qed
 
     lemma contains_head_reduction_iff:
     shows "contains_head_reduction t \<longleftrightarrow> Arr t \<and> \<not> Ide (head_redex t)"
       apply (induct t)
           apply simp_all
     proof -
       show "\<And>t2. contains_head_reduction t1 = (Arr t1 \<and> \<not> Ide (head_redex t1))
                     \<Longrightarrow> contains_head_reduction (t1 \<^bold>\<circ> t2) =
                         (Arr t1 \<and> Arr t2 \<and> \<not> Ide (head_redex (t1 \<^bold>\<circ> t2)))"
         for t1
         using Ide_Src
         by (cases t1) auto
     qed
 
     lemma head_redex_is_head_reduction:
     shows "\<lbrakk>Arr t; contains_head_reduction t\<rbrakk> \<Longrightarrow> is_head_reduction (head_redex t)"
       using Ide_Src
       apply (induct t)
           apply simp_all
     proof -
       show "\<And>t2. \<lbrakk>contains_head_reduction t1 \<Longrightarrow> is_head_reduction (head_redex t1);
                   Arr t1 \<and> Arr t2;
                   contains_head_reduction (t1 \<^bold>\<circ> t2); \<And>t. Arr t \<Longrightarrow> Ide (Src t)\<rbrakk>
                     \<Longrightarrow> is_head_reduction (head_redex (t1 \<^bold>\<circ> t2))"
         for t1
         using Ide_Src contains_head_reduction_iff subs_implies_prfx
         by (cases t1) auto
     qed
 
     lemma Arr_head_redex:
     assumes "Arr t"
     shows "Arr (head_redex t)"
       using assms Ide_implies_Arr elementary_reduction_head_redex elementary_reduction_is_arr
       by blast
 
     lemma Src_head_redex:
     assumes "Arr t"
     shows "Src (head_redex t) = Src t"
       using assms
       by (metis Coinitial_iff_Con Ide.simps(1) ide_char subs_head_redex subs_implies_prfx)
 
     lemma Con_Arr_head_redex:
     assumes "Arr t"
     shows "Con t (head_redex t)"
       using assms
       by (metis Con_sym Ide.simps(1) ide_char subs_head_redex subs_implies_prfx)
 
     lemma is_head_reduction_if:
     shows "\<lbrakk>contains_head_reduction u; elementary_reduction u\<rbrakk> \<Longrightarrow> is_head_reduction u"
       apply (induct u)
           apply auto
       using contains_head_reduction.elims(2)
        apply fastforce
     proof -
       fix u1 u2
       assume u1: "Ide u1"
       assume u2: "elementary_reduction u2"
       assume 1: "contains_head_reduction (u1 \<^bold>\<circ> u2)"
       have False
         using u1 u2 1
         apply (cases u1)
             apply auto
         by (metis Arr_head_redex Ide_iff_Src_self Src_head_redex contains_head_reduction_iff
             ide_char resid_Arr_Src subs_head_redex subs_implies_prfx u1)
       thus "is_head_reduction (u1 \<^bold>\<circ> u2)"
         by blast
     qed
 
     lemma (in reduction_paths) head_redex_decomp:
     assumes "\<Lambda>.Arr t"
     shows "[\<Lambda>.head_redex t] @ [t \\ \<Lambda>.head_redex t] \<^sup>*\<sim>\<^sup>* [t]"
       using assms prfx_decomp \<Lambda>.subs_head_redex \<Lambda>.subs_implies_prfx
       by (metis Ide.simps(2) Resid.simps(3) \<Lambda>.prfx_implies_con ide_char)
 
     text \<open>
       An internal reduction cannot create a new head redex.
     \<close>
 
     lemma internal_reduction_preserves_no_head_redex:
     shows "\<lbrakk>is_internal_reduction u; Ide (head_strategy (Src u))\<rbrakk>
               \<Longrightarrow> Ide (head_strategy (Trg u))"
       apply (induct u)
           apply simp_all
     proof -
       fix u1 u2
       assume ind1: "\<lbrakk>is_internal_reduction u1; Ide (head_strategy (Src u1))\<rbrakk>
                        \<Longrightarrow> Ide (head_strategy (Trg u1))"
       assume ind2: "\<lbrakk>is_internal_reduction u2; Ide (head_strategy (Src u2))\<rbrakk>
                        \<Longrightarrow> Ide (head_strategy (Trg u2))"
       assume u: "is_internal_reduction (u1 \<^bold>\<circ> u2)"
       assume 1: "Ide (head_strategy (Src u1 \<^bold>\<circ> Src u2))"
       show "Ide (head_strategy (Trg u1 \<^bold>\<circ> Trg u2))"
         using u 1 ind1 ind2 Ide_Src Ide_Trg Ide_implies_Arr
         by (cases u1) auto
     qed
 
     lemma head_reduction_unique:
     shows "\<lbrakk>is_head_reduction t; is_head_reduction u; coinitial t u\<rbrakk> \<Longrightarrow> t = u"
       by (metis Coinitial_iff_Con con_def confluence is_head_reduction_char null_char)
 
     text \<open>
       Residuation along internal reductions preserves head reductions.
     \<close>
 
     lemma resid_head_strategy_internal:
     shows "is_internal_reduction u \<Longrightarrow> head_strategy (Src u) \\ u = head_strategy (Trg u)"
       using internal_reduction_preserves_no_head_redex Arr_head_strategy Ide_iff_Src_self
           Src_head_strategy Src_resid head_strategy_is_elementary is_head_reduction_char
           is_head_reduction_resid' is_internal_reduction_iff
       apply (cases u)
           apply simp_all
         apply (metis head_strategy_Src resid_Src_Arr)
        apply (metis head_strategy_Src Arr.simps(4) Src.simps(4) Trg.simps(3) resid_Src_Arr)
       by blast
 
     text \<open>
       An internal reduction followed by a head reduction can be expressed
       as a join of the internal reduction with a head reduction.
     \<close>
 
     lemma resid_head_strategy_Src:
     assumes "is_internal_reduction t" and "is_head_reduction u"
     and "seq t u"
     shows "head_strategy (Src t) \\ t = u"
     and "composite_of t u (Join (head_strategy (Src t)) t)"
     proof -
       show 1: "head_strategy (Src t) \\ t = u"
         using assms internal_reduction_preserves_no_head_redex resid_head_strategy_internal
               elementary_reduction_not_ide ide_char is_head_reduction_char seq_char
         by force
       show "composite_of t u (Join (head_strategy (Src t)) t)"
         using assms(3) 1 Arr_head_strategy Src_head_strategy join_of_Join join_of_def seq_char
         by force
     qed
 
     lemma App_Var_contains_no_head_reduction:
     shows "\<not> contains_head_reduction (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> u)"
       by simp
 
     lemma hgt_resid_App_head_redex:
     assumes "Arr (t \<^bold>\<circ> u)" and "\<not> Ide (head_redex (t \<^bold>\<circ> u))"
     shows "hgt ((t \<^bold>\<circ> u) \\ head_redex (t \<^bold>\<circ> u)) < hgt (t \<^bold>\<circ> u)"
       using assms contains_head_reduction_iff elementary_reduction_decreases_hgt
             elementary_reduction_head_redex subs_head_redex
       by blast
 
     subsection "Leftmost Reduction"
 
     text \<open>
       Leftmost (or normal-order) reduction is the strategy that produces an elementary
       reduction path by contracting the leftmost redex at each step.  It agrees with
       head reduction as long as there is a head redex, otherwise it continues on with the next
       subterm to the right.
     \<close>
 
     fun leftmost_strategy
     where "leftmost_strategy \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> = \<^bold>\<guillemotleft>x\<^bold>\<guillemotright>"
         | "leftmost_strategy \<^bold>\<lambda>\<^bold>[t\<^bold>] = \<^bold>\<lambda>\<^bold>[leftmost_strategy t\<^bold>]"
         | "leftmost_strategy (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<circ> u) = \<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u"
         | "leftmost_strategy (t \<^bold>\<circ> u) =
              (if \<not> Ide (leftmost_strategy t)
               then leftmost_strategy t \<^bold>\<circ> u
               else t \<^bold>\<circ> leftmost_strategy u)"
         | "leftmost_strategy (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) = \<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u"
         | "leftmost_strategy \<^bold>\<sharp> = \<^bold>\<sharp>"
 
     (* TODO: Consider if is_head_reduction should be done this way. *)
     definition is_leftmost_reduction
     where "is_leftmost_reduction t \<longleftrightarrow> elementary_reduction t \<and> leftmost_strategy (Src t) = t"
 
     lemma leftmost_strategy_is_reduction_strategy:
     shows "reduction_strategy leftmost_strategy"
     proof (unfold reduction_strategy_def, intro allI impI)
       fix t
       show "Ide t \<Longrightarrow> Coinitial (leftmost_strategy t) t"
       proof (induct t, auto)
         show "\<And>t2. \<lbrakk>Arr (leftmost_strategy t1); Arr (leftmost_strategy t2);
                     Ide t1; Ide t2;
                     Arr t1; Src (leftmost_strategy t1) = Src t1;
                     Arr t2; Src (leftmost_strategy t2) = Src t2\<rbrakk>
                       \<Longrightarrow> Arr (leftmost_strategy (t1 \<^bold>\<circ> t2))"
               for t1
           by (cases t1) auto
       qed
     qed
 
     lemma elementary_reduction_leftmost_strategy:
     shows "Ide t \<Longrightarrow> elementary_reduction (leftmost_strategy t) \<or> Ide (leftmost_strategy t)"
       apply (induct t)
           apply simp_all
     proof -
       fix t1 t2
       show "\<lbrakk>elementary_reduction (leftmost_strategy t1) \<or> Ide (leftmost_strategy t1);
              elementary_reduction (leftmost_strategy t2) \<or> Ide (leftmost_strategy t2);
              Ide t1 \<and> Ide t2\<rbrakk>
                 \<Longrightarrow> elementary_reduction (leftmost_strategy (t1 \<^bold>\<circ> t2)) \<or>
                     Ide (leftmost_strategy (t1 \<^bold>\<circ> t2))"
         by (cases t1) auto
     qed
 
     lemma (in lambda_calculus) leftmost_strategy_selects_head_reduction:
     shows "is_head_reduction t \<Longrightarrow> t = leftmost_strategy (Src t)"
     proof (induct t)
       show "\<And>t1 t2. \<lbrakk>is_head_reduction t1 \<Longrightarrow> t1 = leftmost_strategy (Src t1);
                      is_head_reduction (t1 \<^bold>\<circ> t2)\<rbrakk>
                        \<Longrightarrow> t1 \<^bold>\<circ> t2 = leftmost_strategy (Src (t1 \<^bold>\<circ> t2))"
       proof -
         fix t1 t2
         assume ind1: "is_head_reduction t1 \<Longrightarrow> t1 = leftmost_strategy (Src t1)"
         assume t: "is_head_reduction (t1 \<^bold>\<circ> t2)"
         show "t1 \<^bold>\<circ> t2 = leftmost_strategy (Src (t1 \<^bold>\<circ> t2))"
           using t ind1
           apply (cases t1)
               apply simp_all
            apply (cases "Src t1")
                apply simp_all
           using ind1
                apply force
           using ind1
               apply force
           using ind1
              apply force
             apply (metis Ide_iff_Src_self Ide_implies_Arr elementary_reduction_not_ide
               ide_char ind1 is_head_reduction_char)
           using ind1
            apply force
           by (metis Ide_iff_Src_self Ide_implies_Arr)
       qed
       show "\<And>t1 t2. \<lbrakk>is_head_reduction t1 \<Longrightarrow> t1 = leftmost_strategy (Src t1);
                      is_head_reduction (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)\<rbrakk>
                        \<Longrightarrow> \<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2 = leftmost_strategy (Src (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2))"
         by (metis Ide_iff_Src_self Ide_implies_Arr Src.simps(5)
             is_head_reduction.simps(8) leftmost_strategy.simps(3))
     qed auto
 
     lemma has_redex_iff_not_Ide_leftmost_strategy:
     shows "Arr t \<Longrightarrow> has_redex t \<longleftrightarrow> \<not> Ide (leftmost_strategy (Src t))"
       apply (induct t)
           apply simp_all
     proof -
       fix t1 t2
       assume ind1: "Ide (parallel_strategy t1) \<longleftrightarrow> Ide (leftmost_strategy (Src t1))"
       assume ind2: "Ide (parallel_strategy t2) \<longleftrightarrow> Ide (leftmost_strategy (Src t2))"
       assume t: "Arr t1 \<and> Arr t2"
       show "Ide (parallel_strategy (t1 \<^bold>\<circ> t2)) \<longleftrightarrow>
             Ide (leftmost_strategy (Src t1 \<^bold>\<circ> Src t2))"
         using t ind1 ind2 Ide_Src Ide_iff_Src_self
         by (cases t1) auto
     qed
 
     lemma leftmost_reduction_preservation:
-    shows "\<And>u. \<lbrakk>is_leftmost_reduction t; elementary_reduction u; \<not> is_leftmost_reduction u;
-                coinitial t u\<rbrakk> \<Longrightarrow> is_leftmost_reduction (t \\ u)"
-    proof (induct t)
+    shows "\<lbrakk>is_leftmost_reduction t; elementary_reduction u; \<not> is_leftmost_reduction u;
+            coinitial t u\<rbrakk> \<Longrightarrow> is_leftmost_reduction (t \\ u)"
+    proof (induct t arbitrary: u)
       show "\<And>u. coinitial \<^bold>\<sharp> u \<Longrightarrow> is_leftmost_reduction (\<^bold>\<sharp> \\ u)"
         by simp
       show "\<And>x u. is_leftmost_reduction \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<Longrightarrow> is_leftmost_reduction (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \\ u)"
         by (simp add: is_leftmost_reduction_def)
       fix t u
       show "\<lbrakk>\<And>u. \<lbrakk>is_leftmost_reduction t; elementary_reduction u;
                    \<not> is_leftmost_reduction u; coinitial t u\<rbrakk> \<Longrightarrow> is_leftmost_reduction (t \\ u);
              is_leftmost_reduction (Lam t); elementary_reduction u;
              \<not> is_leftmost_reduction u; coinitial \<^bold>\<lambda>\<^bold>[t\<^bold>] u\<rbrakk>
                 \<Longrightarrow> is_leftmost_reduction (\<^bold>\<lambda>\<^bold>[t\<^bold>] \\ u)"
         using is_leftmost_reduction_def
         by (cases u) auto
       next
       fix t1 t2 u
       show "\<lbrakk>is_leftmost_reduction (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2); elementary_reduction u; \<not> is_leftmost_reduction u;
              coinitial (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) u\<rbrakk>
                \<Longrightarrow> is_leftmost_reduction ((\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) \\ u)"
         using is_leftmost_reduction_def Src_resid Ide_Trg Ide_iff_Src_self Arr_Trg Arr_not_Nil
         apply (cases u)
             apply simp_all
         by (cases "un_App1 u") auto
       assume ind1: "\<And>u. \<lbrakk>is_leftmost_reduction t1; elementary_reduction u;
                           \<not> is_leftmost_reduction u; coinitial t1 u\<rbrakk>
                             \<Longrightarrow> is_leftmost_reduction (t1 \\ u)"
       assume ind2: "\<And>u. \<lbrakk>is_leftmost_reduction t2; elementary_reduction u;
                          \<not> is_leftmost_reduction u; coinitial t2 u\<rbrakk>
                             \<Longrightarrow> is_leftmost_reduction (t2 \\ u)"
       assume 1: "is_leftmost_reduction (t1 \<^bold>\<circ> t2)"
       assume 2: "elementary_reduction u"
       assume 3: "\<not> is_leftmost_reduction u"
       assume 4: "coinitial (t1 \<^bold>\<circ> t2) u"
       show "is_leftmost_reduction ((t1 \<^bold>\<circ> t2) \\ u)"
         using 1 2 3 4 ind1 ind2 is_leftmost_reduction_def Src_resid
         apply (cases u)
             apply auto[3]
       proof -
         show "\<And>u1 u2. u = \<^bold>\<lambda>\<^bold>[u1\<^bold>] \<^bold>\<Zspot> u2 \<Longrightarrow> is_leftmost_reduction ((t1 \<^bold>\<circ> t2) \\ u)"
           by (metis 2 3 is_leftmost_reduction_def elementary_reduction.simps(5)
               is_head_reduction.simps(8) leftmost_strategy_selects_head_reduction)
         fix u1 u2
         assume u: "u = u1 \<^bold>\<circ> u2"
         show "is_leftmost_reduction ((t1 \<^bold>\<circ> t2) \\ u)"
           using u 1 2 3 4 ind1 ind2 is_leftmost_reduction_def Src_resid Ide_Trg
                 elementary_reduction_not_ide
           apply (cases u)
               apply simp_all
           apply (cases u1)
               apply simp_all
             apply auto[1]
           using Ide_iff_Src_self
            apply simp_all
         proof -
           fix u11 u12
           assume u: "u = u11 \<^bold>\<circ> u12 \<^bold>\<circ> u2"
           assume u1: "u1 = u11 \<^bold>\<circ> u12"
           have A: "(elementary_reduction t1 \<and> Src u2 = t2 \<or>
                       Src u11 \<^bold>\<circ> Src u12 = t1 \<and> elementary_reduction t2) \<and>
                      (if \<not> Ide (leftmost_strategy (Src u11 \<^bold>\<circ> Src u12))
                       then leftmost_strategy (Src u11 \<^bold>\<circ> Src u12) \<^bold>\<circ> Src u2
                       else Src u11 \<^bold>\<circ> Src u12 \<^bold>\<circ> leftmost_strategy (Src u2)) = t1 \<^bold>\<circ> t2"
             using 1 4 Ide_iff_Src_self is_leftmost_reduction_def u by auto
           have B: "(elementary_reduction u11 \<and> Src u12 = u12 \<or>
                       Src u11 = u11 \<and> elementary_reduction u12) \<and> Src u2 = u2 \<or>
                       Src u11 = u11 \<and> Src u12 = u12 \<and> elementary_reduction u2"
             using "2" "4" Ide_iff_Src_self u by force
           have C: "t1 = u11 \<^bold>\<circ> u12 \<longrightarrow> t2 \<noteq> u2"
             using 1 3 u by fastforce
           have D: "Arr t1 \<and> Arr t2 \<and> Arr u11 \<and> Arr u12 \<and> Arr u2 \<and>
                      Src t1 = Src u11 \<^bold>\<circ> Src u12 \<and> Src t2 = Src u2"
             using 4 u by force
           have E: "\<And>u. \<lbrakk>elementary_reduction t1 \<and> leftmost_strategy (Src u) = t1;
                           elementary_reduction u;
                           t1 \<noteq> u;
                           Arr u \<and> Src u11 \<^bold>\<circ> Src u12 = Src u\<rbrakk>
                             \<Longrightarrow> elementary_reduction (t1 \\ u) \<and>
                                 leftmost_strategy (Trg u) = t1 \\ u"
             using D Src_resid ind1 is_leftmost_reduction_def by auto
           have F: "\<And>u. \<lbrakk>elementary_reduction t2 \<and> leftmost_strategy (Src u) = t2;
                           elementary_reduction u;
                           t2 \<noteq> u;
                           Arr u \<and> Src u2 = Src u\<rbrakk>
                             \<Longrightarrow> elementary_reduction (t2 \\ u) \<and>
                                 leftmost_strategy (Trg u) = t2 \\ u"
             using D Src_resid ind2 is_leftmost_reduction_def by auto
           have G: "\<And>t. elementary_reduction t \<Longrightarrow> \<not> Ide t"
             using elementary_reduction_not_ide ide_char by blast
           have H: "elementary_reduction (t1 \\ (u11 \<^bold>\<circ> u12)) \<and> Ide (t2 \\ u2) \<or>
                      Ide (t1 \\ (u11 \<^bold>\<circ> u12)) \<and> elementary_reduction (t2 \\ u2)"
           proof (cases "Ide (t2 \\ u2)")
             assume 1: "Ide (t2 \\ u2)"
             hence "elementary_reduction (t1 \\ (u11 \<^bold>\<circ> u12))"
               by (metis A B C D E F G Ide_Src Arr.simps(4) Src.simps(4)
                   elementary_reduction.simps(4) lambda.inject(3) resid_Arr_Src)
             thus ?thesis
               using 1 by auto
             next
             assume 1: "\<not> Ide (t2 \\ u2)"
             hence "Ide (t1 \\ (u11 \<^bold>\<circ> u12)) \<and> elementary_reduction (t2 \\ u2)"
               apply (intro conjI)
                apply (metis 1 A D Ide_Src Arr.simps(4) Src.simps(4) resid_Ide_Arr)
               by (metis A B C D F Ide_iff_Src_self lambda.inject(3) resid_Arr_Src resid_Ide_Arr)
             thus ?thesis by simp
           qed
           show "(\<not> Ide (leftmost_strategy (Trg u11 \<^bold>\<circ> Trg u12)) \<longrightarrow>
                   (elementary_reduction (t1 \\ (u11 \<^bold>\<circ> u12)) \<and> Ide (t2 \\ u2) \<or>
                    Ide (t1 \\ (u11 \<^bold>\<circ> u12)) \<and> elementary_reduction (t2 \\ u2)) \<and>
                    leftmost_strategy (Trg u11 \<^bold>\<circ> Trg u12) = t1 \\ (u11 \<^bold>\<circ> u12) \<and> Trg u2 = t2 \\ u2) \<and>
                 (Ide (leftmost_strategy (Trg u11 \<^bold>\<circ> Trg u12)) \<longrightarrow>
                   (elementary_reduction (t1 \\ (u11 \<^bold>\<circ> u12)) \<and> Ide (t2 \\ u2) \<or>
                    Ide (t1 \\ (u11 \<^bold>\<circ> u12)) \<and> elementary_reduction (t2 \\ u2)) \<and>
                    Trg u11 \<^bold>\<circ> Trg u12 = t1 \\ (u11 \<^bold>\<circ> u12) \<and> leftmost_strategy (Trg u2) = t2 \\ u2)"
           proof (intro conjI impI)
             show H: "elementary_reduction (t1 \\ (u11 \<^bold>\<circ> u12)) \<and> Ide (t2 \\ u2) \<or>
                        Ide (t1 \\ (u11 \<^bold>\<circ> u12)) \<and> elementary_reduction (t2 \\ u2)"
               by fact
             show H: "elementary_reduction (t1 \\ (u11 \<^bold>\<circ> u12)) \<and> Ide (t2 \\ u2) \<or>
                        Ide (t1 \\ (u11 \<^bold>\<circ> u12)) \<and> elementary_reduction (t2 \\ u2)"
               by fact
             assume K: "\<not> Ide (leftmost_strategy (Trg u11 \<^bold>\<circ> Trg u12))"
             show J: "Trg u2 = t2 \\ u2"
               using A B D G K has_redex_iff_not_Ide_leftmost_strategy
                     NF_def NF_iff_has_no_redex NF_App_iff resid_Arr_Src resid_Src_Arr
               by (metis lambda.inject(3))
             show "leftmost_strategy (Trg u11 \<^bold>\<circ> Trg u12) = t1 \\ (u11 \<^bold>\<circ> u12)"
               using 2 A B C D E G H J u Ide_Trg Src_Src
                   has_redex_iff_not_Ide_leftmost_strategy resid_Arr_Ide resid_Src_Arr
               by (metis Arr.simps(4) Ide.simps(4) Src.simps(4) Trg.simps(3)
                   elementary_reduction.simps(4) lambda.inject(3))
             next
             assume K: "Ide (leftmost_strategy (Trg u11 \<^bold>\<circ> Trg u12))"
             show I: "Trg u11 \<^bold>\<circ> Trg u12 = t1 \\ (u11 \<^bold>\<circ> u12)"
               using 2 A D E K u Coinitial_resid_resid ConI resid_Arr_self resid_Ide_Arr
                     resid_Arr_Ide Ide_iff_Src_self Src_resid
               apply (cases "Ide (leftmost_strategy (Src u11 \<^bold>\<circ> Src u12))")
                apply simp
               using lambda_calculus.Con_Arr_Src(2)
                apply force
               apply simp
               using u1 G H Coinitial_iff_Con
               apply (cases "elementary_reduction u11";
                      cases "elementary_reduction u12")
                  apply simp_all
                  apply metis
                 apply (metis Src.simps(4) Trg.simps(3) elementary_reduction.simps(1,4))
                apply (metis Src.simps(4) Trg.simps(3) elementary_reduction.simps(1,4))
               by (metis Trg_Src)
             show "leftmost_strategy (Trg u2) = t2 \\ u2"
               using 2 A C D F G H I u Ide_Trg Ide_iff_Src_self NF_def NF_iff_has_no_redex
                     has_redex_iff_not_Ide_leftmost_strategy resid_Ide_Arr
               by (metis Arr.simps(4) Src.simps(4) Trg.simps(3) elementary_reduction.simps(4)
                   lambda.inject(3))
           qed
         qed
       qed
     qed
 
   end
 
   section "Standard Reductions"
 
     text \<open>
       In this section, we define the notion of a \emph{standard reduction}, which is an
       elementary reduction path that performs reductions from left to right, possibly
       skipping some redexes that could be contracted.  Once a redex has been skipped,
       neither that redex nor any redex to its left will subsequently be contracted.
       We then define and prove correct a function that transforms an arbitrary
       elementary reduction path into a congruent standard reduction path.
       Using this function, we prove the Standardization Theorem, which says that
       every elementary reduction path is congruent to a standard reduction path.
       We then show that a standard reduction path that reaches a normal form is in
       fact a leftmost reduction path.  From this fact and the Standardization Theorem
       we prove the Leftmost Reduction Theorem: leftmost reduction is a normalizing
       strategy.
 
       The Standardization Theorem was first proved by Curry and Feys \cite{curry-and-feys},
       with subsequent proofs given by a number of authors.  Formalized proofs have also
       been given; a recent one (using Agda) is presented in \cite{copes}, with references
       to earlier work.  The version of the theorem that we formalize here is a ``strong''
       version, which asserts the existence of a standard reduction path congruent to a
       a given elementary reduction path.  At the core of the proof is a function that
       directly transforms a given reduction path into a standard one, using an algorithm
       roughly analogous to insertion sort.  The Finite Development Theorem is used in the
       proof of termination.  The proof of correctness is long, due to the number of cases that
       have to be considered, but the use of a proof assistant makes this manageable.
     \<close>
 
   subsection "Standard Reduction Paths"
 
   subsubsection "`Standardly Sequential' Reductions"
 
     text \<open>
       We first need to define the notion of a ``standard reduction''.  In contrast to what
       is typically done by other authors, we define this notion by direct comparison of adjacent
       terms in an elementary reduction path, rather than by using devices such as a numbering
       of subterms from left to right.
 
       The following function decides when two terms \<open>t\<close> and \<open>u\<close> are elementary reductions that are
       ``standardly sequential''.  This means that \<open>t\<close> and \<open>u\<close> are sequential, but in addition
       no marked redex in \<open>u\<close> is the residual of an (unmarked) redex ``to the left of'' any
       marked redex in \<open>t\<close>.  Some care is required to make sure that the recursive definition
       captures what we intend.  Most of the clauses are readily understandable.
       One clause that perhaps could use some explanation is the one for
       \<open>sseq ((\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) \<^bold>\<circ> v) w\<close>.  Referring to the previously proved fact \<open>seq_cases\<close>,
       which classifies the way in which two terms \<open>t\<close> and \<open>u\<close> can be sequential,
       we see that one case that must be covered is when \<open>t\<close> has the form \<open>\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> v) \<^bold>\<circ> w\<close>
       and the top-level constructor of \<open>u\<close> is \<open>Beta\<close>.  In this case, it is the reduction
       of \<open>t\<close> that creates the top-level redex contracted in \<open>u\<close>, so it is impossible for \<open>u\<close> to
       be a residual of a redex that already exists in \<open>Src t\<close>.
     \<close>
 
   context lambda_calculus
   begin
 
     fun sseq
     where "sseq _ \<^bold>\<sharp> = False"
         | "sseq \<^bold>\<guillemotleft>_\<^bold>\<guillemotright> \<^bold>\<guillemotleft>_\<^bold>\<guillemotright> = False"
         | "sseq \<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<lambda>\<^bold>[t'\<^bold>] = sseq t t'"
         | "sseq (t \<^bold>\<circ> u) (t' \<^bold>\<circ> u') =
                 ((sseq t t' \<and> Ide u \<and> u = u') \<or>
                  (Ide t \<and> t = t' \<and> sseq u u') \<or>
                  (elementary_reduction t \<and> Trg t = t' \<and>
                   (u = Src u' \<and> elementary_reduction u')))"
         | "sseq (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<circ> u) (\<^bold>\<lambda>\<^bold>[t'\<^bold>] \<^bold>\<Zspot> u') = False"
         | "sseq ((\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) \<^bold>\<circ> v) w =
                 (Ide t \<and> Ide u \<and> Ide v \<and> elementary_reduction w \<and> seq ((\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) \<^bold>\<circ> v) w)"
         | "sseq (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) v = (Ide t \<and> Ide u \<and> elementary_reduction v \<and> seq (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) v)"
         | "sseq _ _ = False"
 
     lemma sseq_imp_seq:
-    shows "\<And>u. sseq t u \<Longrightarrow> seq t u"
-    proof (induct t)
+    shows "sseq t u \<Longrightarrow> seq t u"
+    proof (induct t arbitrary: u)
       show "\<And>u. sseq \<^bold>\<sharp> u \<Longrightarrow> seq \<^bold>\<sharp> u"
         using sseq.elims(1) by blast
       fix u
       show "\<And>x. sseq \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> u \<Longrightarrow> seq \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> u"
         using sseq.elims(1) by blast
       show "\<And>t. \<lbrakk>\<And>u. sseq t u \<Longrightarrow> seq t u; sseq \<^bold>\<lambda>\<^bold>[t\<^bold>] u\<rbrakk> \<Longrightarrow> seq \<^bold>\<lambda>\<^bold>[t\<^bold>] u"
         using seq_char by (cases u) auto
       show "\<And>t1 t2. \<lbrakk>\<And>u. sseq t1 u \<Longrightarrow> seq t1 u; \<And>u. sseq t2 u \<Longrightarrow> seq t2 u;
                      sseq (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) u\<rbrakk>
                         \<Longrightarrow> seq (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) u"
         using seq_char Ide_implies_Arr
         by (cases u) auto
       fix t1 t2
       show "\<lbrakk>\<And>u. sseq t1 u \<Longrightarrow> seq t1 u; \<And>u. sseq t2 u \<Longrightarrow> seq t2 u; sseq (t1 \<^bold>\<circ> t2) u\<rbrakk>
                   \<Longrightarrow> seq (t1 \<^bold>\<circ> t2) u"
       proof -
         assume ind1: "\<And>u. sseq t1 u \<Longrightarrow> seq t1 u"
         assume ind2: "\<And>u. sseq t2 u \<Longrightarrow> seq t2 u"
         assume 1: "sseq (t1 \<^bold>\<circ> t2) u"
         show ?thesis
           using 1 ind1 ind2 seq_char arr_char elementary_reduction_is_arr
                 Ide_Src Ide_Trg Ide_implies_Arr Coinitial_iff_Con resid_Arr_self
           apply (cases u, simp_all)
              apply (cases t1, simp_all)
             apply (cases t1, simp_all)
            apply (cases "Ide t1"; cases "Ide t2")
               apply simp_all
              apply (metis Ide_iff_Src_self Ide_iff_Trg_self)
             apply (metis Ide_iff_Src_self Ide_iff_Trg_self)
            apply (metis Ide_iff_Trg_self Src_Trg)
           by (cases t1) auto
       qed
     qed
 
     lemma sseq_imp_elementary_reduction1:
-    shows "\<And>t. sseq t u \<Longrightarrow> elementary_reduction t"
-    proof (induct u)
+    shows "sseq t u \<Longrightarrow> elementary_reduction t"
+    proof (induct u arbitrary: t)
       show "\<And>t. sseq t \<^bold>\<sharp> \<Longrightarrow> elementary_reduction t"
         by simp
       show "\<And>x t. sseq t \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<Longrightarrow> elementary_reduction t"
         using elementary_reduction.simps(2) sseq.elims(1) by blast
       show "\<And>u. \<lbrakk>\<And>t. sseq t u \<Longrightarrow> elementary_reduction t; sseq t \<^bold>\<lambda>\<^bold>[u\<^bold>]\<rbrakk>
                     \<Longrightarrow> elementary_reduction t" for t
         using seq_cases sseq_imp_seq
         apply (cases t, simp_all)
         by force
       show "\<And>u1 u2. \<lbrakk>\<And>t. sseq t u1 \<Longrightarrow> elementary_reduction t;
                      \<And>t. sseq t u2 \<Longrightarrow> elementary_reduction t;
                      sseq t (u1 \<^bold>\<circ> u2)\<rbrakk>
                        \<Longrightarrow> elementary_reduction t" for t
         using seq_cases sseq_imp_seq Ide_Src elementary_reduction_is_arr
         apply (cases t, simp_all)
         by blast
       show "\<And>u1 u2.
        \<lbrakk>\<And>t. sseq t u1 \<Longrightarrow> elementary_reduction t; \<And>t. sseq t u2 \<Longrightarrow> elementary_reduction t;
         sseq t (\<^bold>\<lambda>\<^bold>[u1\<^bold>] \<^bold>\<Zspot> u2)\<rbrakk>
        \<Longrightarrow> elementary_reduction t" for t
         using seq_cases sseq_imp_seq
         apply (cases t, simp_all)
         by fastforce
     qed
 
     lemma sseq_imp_elementary_reduction2:
-    shows "\<And>t. sseq t u \<Longrightarrow> elementary_reduction u"
-    proof (induct u)
+    shows "sseq t u \<Longrightarrow> elementary_reduction u"
+    proof (induct u arbitrary: t)
       show "\<And>t. sseq t \<^bold>\<sharp> \<Longrightarrow> elementary_reduction \<^bold>\<sharp>"
         by simp
       show "\<And>x t. sseq t \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<Longrightarrow> elementary_reduction \<^bold>\<guillemotleft>x\<^bold>\<guillemotright>"
         using elementary_reduction.simps(2) sseq.elims(1) by blast
       show "\<And>u. \<lbrakk>\<And>t. sseq t u \<Longrightarrow> elementary_reduction u; sseq t \<^bold>\<lambda>\<^bold>[u\<^bold>]\<rbrakk>
                    \<Longrightarrow> elementary_reduction \<^bold>\<lambda>\<^bold>[u\<^bold>]" for t
         using seq_cases sseq_imp_seq
         apply (cases t, simp_all)
         by force
       show "\<And>u1 u2. \<lbrakk>\<And>t. sseq t u1 \<Longrightarrow> elementary_reduction u1;
                      \<And>t. sseq t u2 \<Longrightarrow> elementary_reduction u2;
                      sseq t (u1 \<^bold>\<circ> u2)\<rbrakk>
                        \<Longrightarrow> elementary_reduction (u1 \<^bold>\<circ> u2)" for t
         using seq_cases sseq_imp_seq Ide_Trg elementary_reduction_is_arr
         by (cases t) auto
       show "\<And>u1 u2. \<lbrakk>\<And>t. sseq t u1 \<Longrightarrow> elementary_reduction u1;
                      \<And>t. sseq t u2 \<Longrightarrow> elementary_reduction u2;
                      sseq t (\<^bold>\<lambda>\<^bold>[u1\<^bold>] \<^bold>\<Zspot> u2)\<rbrakk>
                        \<Longrightarrow> elementary_reduction (\<^bold>\<lambda>\<^bold>[u1\<^bold>] \<^bold>\<Zspot> u2)" for t
         using seq_cases sseq_imp_seq
         apply (cases t, simp_all)
         by fastforce
     qed
 
     lemma sseq_Beta:
     shows "sseq (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) v \<longleftrightarrow> Ide t \<and> Ide u \<and> elementary_reduction v \<and> seq (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) v"
       by (cases v) auto
 
     lemma sseq_BetaI [intro]:
     assumes "Ide t" and "Ide u" and "elementary_reduction v" and "seq (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) v"
     shows "sseq (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) v"
       using assms sseq_Beta by simp
 
     text \<open>
       A head reduction is standardly sequential with any elementary reduction that
       can be performed after it.
     \<close>
 
     lemma sseq_head_reductionI:
-    shows "\<And>u. \<lbrakk>is_head_reduction t; elementary_reduction u; seq t u\<rbrakk> \<Longrightarrow> sseq t u"
-    proof (induct t)
+    shows "\<lbrakk>is_head_reduction t; elementary_reduction u; seq t u\<rbrakk> \<Longrightarrow> sseq t u"
+    proof (induct t arbitrary: u)
       show "\<And>u. \<lbrakk>is_head_reduction \<^bold>\<sharp>; elementary_reduction u; seq \<^bold>\<sharp> u\<rbrakk> \<Longrightarrow> sseq \<^bold>\<sharp> u"
         by simp
       show "\<And>x u. \<lbrakk>is_head_reduction \<^bold>\<guillemotleft>x\<^bold>\<guillemotright>; elementary_reduction u; seq \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> u\<rbrakk> \<Longrightarrow> sseq \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> u"
         by auto
       show "\<And>t. \<lbrakk>\<And>u. \<lbrakk>is_head_reduction t; elementary_reduction u; seq t u\<rbrakk> \<Longrightarrow> sseq t u;
                  is_head_reduction \<^bold>\<lambda>\<^bold>[t\<^bold>]; elementary_reduction u; seq \<^bold>\<lambda>\<^bold>[t\<^bold>] u\<rbrakk>
                     \<Longrightarrow> sseq \<^bold>\<lambda>\<^bold>[t\<^bold>] u" for u
         by (cases u) auto
       show "\<And>t2. \<lbrakk>\<And>u. \<lbrakk>is_head_reduction t1; elementary_reduction u; seq t1 u\<rbrakk> \<Longrightarrow> sseq t1 u;
                   \<And>u. \<lbrakk>is_head_reduction t2; elementary_reduction u; seq t2 u\<rbrakk> \<Longrightarrow> sseq t2 u;
                   is_head_reduction (t1 \<^bold>\<circ> t2); elementary_reduction u; seq (t1 \<^bold>\<circ> t2) u\<rbrakk>
                      \<Longrightarrow> sseq (t1 \<^bold>\<circ> t2) u" for t1 u
         using seq_char
         apply (cases u)
             apply simp_all
         apply (metis ArrE Ide_iff_Src_self Ide_iff_Trg_self App_Var_contains_no_head_reduction
             is_head_reduction_char is_head_reduction_imp_contains_head_reduction
             is_head_reduction.simps(3,6-7))
         by (cases t1) auto
       show "\<And>t1 t2 u. \<lbrakk>\<And>u. \<lbrakk>is_head_reduction t1; elementary_reduction u; seq t1 u\<rbrakk> \<Longrightarrow> sseq t1 u;
                        \<And>u. \<lbrakk>is_head_reduction t2; elementary_reduction u; seq t2 u\<rbrakk> \<Longrightarrow> sseq t2 u;
                        is_head_reduction (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2); elementary_reduction u; seq (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) u\<rbrakk>
                          \<Longrightarrow> sseq (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) u"
         by auto
     qed
 
     text \<open>
       Once a head reduction is skipped in an application, then all terms that follow it
       in a standard reduction path are also applications that do not contain head reductions.
     \<close>
 
     lemma sseq_preserves_App_and_no_head_reduction:
-    shows "\<And>u. \<lbrakk>sseq t u; is_App t \<and> \<not> contains_head_reduction t\<rbrakk>
-                   \<Longrightarrow> is_App u \<and> \<not> contains_head_reduction u"
-      apply (induct t)
+    shows "\<lbrakk>sseq t u; is_App t \<and> \<not> contains_head_reduction t\<rbrakk>
+               \<Longrightarrow> is_App u \<and> \<not> contains_head_reduction u"
+      apply (induct t arbitrary: u)
           apply simp_all
     proof -
       fix t1 t2 u
       assume ind1: "\<And>u. \<lbrakk>sseq t1 u; is_App t1 \<and> \<not> contains_head_reduction t1\<rbrakk>
                           \<Longrightarrow> is_App u \<and> \<not> contains_head_reduction u"
       assume ind2: "\<And>u. \<lbrakk>sseq t2 u; is_App t2 \<and> \<not> contains_head_reduction t2\<rbrakk>
                           \<Longrightarrow> is_App u \<and> \<not> contains_head_reduction u"
       assume sseq: "sseq (t1 \<^bold>\<circ> t2) u"
       assume t: "\<not> contains_head_reduction (t1 \<^bold>\<circ> t2)"
       have u: "\<not> is_Beta u"
        using sseq t sseq_imp_seq seq_cases
        by (cases t1; cases u) auto
       have 1: "is_App u"
         using u sseq sseq_imp_seq
         apply (cases u)
             apply simp_all
         by fastforce+
       moreover have "\<not> contains_head_reduction u"
       proof (cases u)
         show "\<And>v. u = \<^bold>\<lambda>\<^bold>[v\<^bold>] \<Longrightarrow> \<not> contains_head_reduction u"
           using 1 by auto
         show "\<And>v w. u = \<^bold>\<lambda>\<^bold>[v\<^bold>] \<^bold>\<Zspot> w \<Longrightarrow> \<not> contains_head_reduction u"
           using u by auto
         fix u1 u2
         assume u: "u = u1 \<^bold>\<circ> u2"
         have 1: "(sseq t1 u1 \<and> Ide t2 \<and> t2 = u2) \<or> (Ide t1 \<and> t1 = u1 \<and> sseq t2 u2) \<or>
                  (elementary_reduction t1 \<and> u1 = Trg t1 \<and> t2 = Src u2 \<and> elementary_reduction u2)"
           using sseq u by force
         moreover have "Ide t1 \<and> t1 = u1 \<and> sseq t2 u2 \<Longrightarrow> ?thesis"
           using Ide_implies_Arr ide_char sseq_imp_seq t u by fastforce
         moreover have "elementary_reduction t1 \<and> u1 = Trg t1 \<and> t2 = Src u2 \<and>
                        elementary_reduction u2
                          \<Longrightarrow> ?thesis"
         proof -
           assume 2: "elementary_reduction t1 \<and> u1 = Trg t1 \<and> t2 = Src u2 \<and>
                      elementary_reduction u2"
           have "contains_head_reduction u \<Longrightarrow> contains_head_reduction u1"
             using u
             apply simp
             using contains_head_reduction.elims(2) by fastforce
           hence "contains_head_reduction u \<Longrightarrow> \<not> Ide u1"
             using contains_head_reduction_iff
             by (metis Coinitial_iff_Con Ide_iff_Src_self Ide_implies_Arr ide_char resid_Arr_Src
                 subs_head_redex subs_implies_prfx)
           thus ?thesis
             using 2
             by (metis Arr.simps(4) Ide_Trg seq_char sseq sseq_imp_seq)
         qed
         moreover have "sseq t1 u1 \<and> Ide t2 \<and> t2 = u2 \<Longrightarrow> ?thesis"
           using t u ind1 [of u1] Ide_implies_Arr sseq_imp_elementary_reduction1
           apply (cases t1, simp_all)
           using elementary_reduction.simps(1)
               apply blast
           using elementary_reduction.simps(2)
              apply blast
           using contains_head_reduction.elims(2)
             apply fastforce
            apply (metis contains_head_reduction.simps(6) is_App_def)
           using sseq_Beta by blast
         ultimately show ?thesis by blast
       qed auto
       ultimately show "is_App u \<and> \<not> contains_head_reduction u"
         by blast
     qed
 
   end
 
   subsubsection "Standard Reduction Paths"
 
   context reduction_paths
   begin
 
     text \<open>
       A \emph{standard reduction path} is an elementary reduction path in which
       successive reductions are standardly sequential.
     \<close>
 
     fun Std
     where "Std [] = True"
         | "Std [t] = \<Lambda>.elementary_reduction t"
         | "Std (t # U) = (\<Lambda>.sseq t (hd U) \<and> Std U)"
 
     lemma Std_consE [elim]:
     assumes "Std (t # U)"
     and "\<lbrakk>\<Lambda>.Arr t; U \<noteq> [] \<Longrightarrow> \<Lambda>.sseq t (hd U); Std U\<rbrakk> \<Longrightarrow> thesis"
     shows thesis
       using assms
       by (metis \<Lambda>.arr_char \<Lambda>.elementary_reduction_is_arr \<Lambda>.seq_char \<Lambda>.sseq_imp_seq
           list.exhaust_sel list.sel(1) Std.simps(1-3))
 
     lemma Std_imp_Arr [simp]:
     shows "\<lbrakk>Std T; T \<noteq> []\<rbrakk> \<Longrightarrow> Arr T"
     proof (induct T)
       show "[] \<noteq> [] \<Longrightarrow> Arr []"
         by simp
       fix t U
       assume ind: "\<lbrakk>Std U; U \<noteq> []\<rbrakk> \<Longrightarrow> Arr U"
       assume tU: "Std (t # U)"
       show "Arr (t # U)"
       proof (cases "U = []")
         show "U = [] \<Longrightarrow> Arr (t # U)"
           using \<Lambda>.elementary_reduction_is_arr tU \<Lambda>.Ide_implies_Arr Std.simps(2) Arr.simps(2)
           by blast
         assume U: "U \<noteq> []"
         show "Arr (t # U)"
         proof -
           have "\<Lambda>.sseq t (hd U)"
             using tU U
             by (metis list.exhaust_sel reduction_paths.Std.simps(3))
           thus ?thesis
             using U ind \<Lambda>.sseq_imp_seq
             apply auto
             using reduction_paths.Std.elims(3) tU
             by fastforce
         qed
       qed
     qed
 
     lemma Std_imp_sseq_last_hd:
-    shows "\<And>U. \<lbrakk>Std (T @ U); T \<noteq> []; U \<noteq> []\<rbrakk> \<Longrightarrow> \<Lambda>.sseq (last T) (hd U)"
-      apply (induct T)
+    shows "\<lbrakk>Std (T @ U); T \<noteq> []; U \<noteq> []\<rbrakk> \<Longrightarrow> \<Lambda>.sseq (last T) (hd U)"
+      apply (induct T arbitrary: U)
        apply simp_all
       by (metis Std.elims(3) Std.simps(3) append_self_conv2 neq_Nil_conv)
 
     lemma Std_implies_set_subset_elementary_reduction:
     shows "Std U \<Longrightarrow> set U \<subseteq> Collect \<Lambda>.elementary_reduction"
       apply (induct U)
         apply auto
       by (metis Std.simps(2) Std.simps(3) neq_Nil_conv \<Lambda>.sseq_imp_elementary_reduction1)
 
     lemma Std_map_Lam:
     shows "Std T \<Longrightarrow> Std (map \<Lambda>.Lam T)"
     proof (induct T)
       show "Std [] \<Longrightarrow> Std (map \<Lambda>.Lam [])"
         by simp
       fix t U
       assume ind: "Std U \<Longrightarrow> Std (map \<Lambda>.Lam U)"
       assume tU: "Std (t # U)"
       have "Std (map \<Lambda>.Lam (t # U)) \<longleftrightarrow> Std (\<^bold>\<lambda>\<^bold>[t\<^bold>] # map \<Lambda>.Lam U)"
         by auto
       also have "... = True"
         apply (cases "U = []")
          apply simp_all
         using Arr.simps(3) Std.simps(2) arr_char tU
          apply presburger
       proof -
         assume U: "U \<noteq> []"
         have "Std (\<^bold>\<lambda>\<^bold>[t\<^bold>] # map \<Lambda>.Lam U) \<longleftrightarrow> \<Lambda>.sseq \<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<lambda>\<^bold>[hd U\<^bold>] \<and> Std (map \<Lambda>.Lam U)"
           using U
           by (metis Nil_is_map_conv Std.simps(3) hd_map list.exhaust_sel)
         also have "... \<longleftrightarrow> \<Lambda>.sseq t (hd U) \<and> Std (map \<Lambda>.Lam U)"
           by auto
         also have "... = True"
           using ind tU U
           by (metis Std.simps(3) list.exhaust_sel)
         finally show "Std (\<^bold>\<lambda>\<^bold>[t\<^bold>] # map \<Lambda>.Lam U)" by blast
       qed
       finally show "Std (map \<Lambda>.Lam (t # U))" by blast
     qed
 
     lemma Std_map_App1:
     shows "\<lbrakk>\<Lambda>.Ide b; Std T\<rbrakk> \<Longrightarrow> Std (map (\<lambda>X. X \<^bold>\<circ> b) T)"
     proof (induct T)
       show "\<lbrakk>\<Lambda>.Ide b; Std []\<rbrakk> \<Longrightarrow> Std (map (\<lambda>X. X \<^bold>\<circ> b) [])"
         by simp
       fix t U
       assume ind: "\<lbrakk>\<Lambda>.Ide b; Std U\<rbrakk> \<Longrightarrow> Std (map (\<lambda>X. X \<^bold>\<circ> b) U)"
       assume b: "\<Lambda>.Ide b"
       assume tU: "Std (t # U)"
       show "Std (map (\<lambda>v. v \<^bold>\<circ> b) (t # U))"
       proof (cases "U = []")
         show "U = [] \<Longrightarrow> ?thesis"
           using Ide_implies_Arr b \<Lambda>.arr_char tU by force
         assume U: "U \<noteq> []"
         have "Std (map (\<lambda>v. v \<^bold>\<circ> b) (t # U)) = Std ((t \<^bold>\<circ> b) # map (\<lambda>X. X \<^bold>\<circ> b) U)"
           by simp
         also have "... = (\<Lambda>.sseq (t \<^bold>\<circ> b) (hd U \<^bold>\<circ> b) \<and> Std (map (\<lambda>X. X \<^bold>\<circ> b) U))"
           using U reduction_paths.Std.simps(3) hd_map
           by (metis Nil_is_map_conv neq_Nil_conv)
         also have "... = True"
           using b tU U ind
           by (metis Std.simps(3) list.exhaust_sel \<Lambda>.sseq.simps(4))
         finally show "Std (map (\<lambda>v. v \<^bold>\<circ> b) (t # U))" by blast
       qed
     qed
 
     lemma Std_map_App2:
     shows "\<lbrakk>\<Lambda>.Ide a; Std T\<rbrakk> \<Longrightarrow> Std (map (\<lambda>u. a \<^bold>\<circ> u) T)"
     proof (induct T)
       show "\<lbrakk>\<Lambda>.Ide a; Std []\<rbrakk> \<Longrightarrow> Std (map (\<lambda>u. a \<^bold>\<circ> u) [])"
         by simp
       fix t U
       assume ind: "\<lbrakk>\<Lambda>.Ide a; Std U\<rbrakk> \<Longrightarrow> Std (map (\<lambda>u. a \<^bold>\<circ> u) U)"
       assume a: "\<Lambda>.Ide a"
       assume tU: "Std (t # U)"
       show "Std (map (\<lambda>u. a \<^bold>\<circ> u) (t # U))"
       proof (cases "U = []")
         show "U = [] \<Longrightarrow> ?thesis"
           using a tU by force
         assume U: "U \<noteq> []"
         have "Std (map (\<lambda>u. a \<^bold>\<circ> u) (t # U)) = Std ((a \<^bold>\<circ> t) # map (\<lambda>u. a \<^bold>\<circ> u) U)"
           by simp
         also have "... = (\<Lambda>.sseq (a \<^bold>\<circ> t) (a \<^bold>\<circ> hd U) \<and> Std (map (\<lambda>u. a \<^bold>\<circ> u) U))"
           using U
           by (metis Nil_is_map_conv Std.simps(3) hd_map list.exhaust_sel)
         also have "... = True"
           using a tU U ind
           by (metis Std.simps(3) list.exhaust_sel \<Lambda>.sseq.simps(4))
         finally show "Std (map (\<lambda>u. a \<^bold>\<circ> u) (t # U))" by blast
       qed
     qed
 
     lemma Std_map_un_Lam:
     shows "\<lbrakk>Std T; set T \<subseteq> Collect \<Lambda>.is_Lam\<rbrakk> \<Longrightarrow> Std (map \<Lambda>.un_Lam T)"
     proof (induct T)
       show "\<lbrakk>Std []; set [] \<subseteq> Collect \<Lambda>.is_Lam\<rbrakk> \<Longrightarrow> Std (map \<Lambda>.un_Lam [])"
         by simp
       fix t T
       assume ind: "\<lbrakk>Std T; set T \<subseteq> Collect \<Lambda>.is_Lam\<rbrakk> \<Longrightarrow> Std (map \<Lambda>.un_Lam T)"
       assume tT: "Std (t # T)"
       assume 1: "set (t # T) \<subseteq> Collect \<Lambda>.is_Lam"
       show "Std (map \<Lambda>.un_Lam (t # T))"
       proof (cases "T = []")
         show "T = [] \<Longrightarrow> Std (map \<Lambda>.un_Lam (t # T))"
         by (metis "1" Std.simps(2) \<Lambda>.elementary_reduction.simps(3) \<Lambda>.lambda.collapse(2)
             list.set_intros(1) list.simps(8) list.simps(9) mem_Collect_eq subset_code(1) tT)
         assume T: "T \<noteq> []"
         show "Std (map \<Lambda>.un_Lam (t # T))"
           using T tT 1 ind Std.simps(3) [of "\<Lambda>.un_Lam t" "\<Lambda>.un_Lam (hd T)" "map \<Lambda>.un_Lam (tl T)"]
           by (metis \<Lambda>.lambda.collapse(2) \<Lambda>.sseq.simps(3) list.exhaust_sel list.sel(1)
               list.set_intros(1) map_eq_Cons_conv mem_Collect_eq reduction_paths.Std.simps(3)
               set_subset_Cons subset_code(1))
       qed
     qed
 
     lemma Std_append_single:
     shows "\<lbrakk>Std T; T \<noteq> []; \<Lambda>.sseq (last T) u\<rbrakk> \<Longrightarrow> Std (T @ [u])"
     proof (induct T)
       show "\<lbrakk>Std []; [] \<noteq> []; \<Lambda>.sseq (last []) u\<rbrakk> \<Longrightarrow> Std ([] @ [u])"
         by blast
       fix t T
       assume ind: "\<lbrakk>Std T; T \<noteq> []; \<Lambda>.sseq (last T) u\<rbrakk> \<Longrightarrow> Std (T @ [u])"
       assume tT: "Std (t # T)"
       assume sseq: "\<Lambda>.sseq (last (t # T)) u"
       have "Std (t # (T @ [u]))"
         using \<Lambda>.sseq_imp_elementary_reduction2 sseq ind tT
         apply (cases "T = []")
          apply simp
         by (metis append_Cons last_ConsR list.sel(1) neq_Nil_conv reduction_paths.Std.simps(3))
       thus "Std ((t # T) @ [u])" by simp
     qed
 
     lemma Std_append:
-    shows "\<And>T. \<lbrakk>Std T; Std U; T = [] \<or> U = [] \<or> \<Lambda>.sseq (last T) (hd U)\<rbrakk> \<Longrightarrow> Std (T @ U)"
-    proof (induct U)
+    shows "\<lbrakk>Std T; Std U; T = [] \<or> U = [] \<or> \<Lambda>.sseq (last T) (hd U)\<rbrakk> \<Longrightarrow> Std (T @ U)"
+    proof (induct U arbitrary: T)
       show "\<And>T. \<lbrakk>Std T; Std []; T = [] \<or> [] = [] \<or> \<Lambda>.sseq (last T) (hd [])\<rbrakk> \<Longrightarrow> Std (T @ [])"
         by simp
       fix u T U
       assume ind: "\<And>T. \<lbrakk>Std T; Std U; T = [] \<or> U = [] \<or> \<Lambda>.sseq (last T) (hd U)\<rbrakk>
                           \<Longrightarrow> Std (T @ U)"
       assume T: "Std T"
       assume uU: "Std (u # U)"
       have U: "Std U"
         using uU Std.elims(3) by fastforce
       assume seq: "T = [] \<or> u # U = [] \<or> \<Lambda>.sseq (last T) (hd (u # U))"
       show "Std (T @ (u # U))"
         by (metis Std_append_single T U append.assoc append.left_neutral append_Cons
             ind last_snoc list.distinct(1) list.exhaust_sel list.sel(1) Std.simps(3) seq uU)
     qed
 
     subsubsection "Projections of Standard `App Paths'"
 
     text \<open>
       Given a standard reduction path, all of whose transitions have App as their top-level
       constructor, we can apply \<open>un_App1\<close> or \<open>un_App2\<close> to each transition to project the path
       onto paths formed from the ``rator'' and the ``rand'' of each application.  These projected
       paths are not standard, since the projection operation will introduce identities,
       in general.  However, in this section we show that if we remove the identities, then
       in fact we do obtain standard reduction paths.
     \<close>
 
     abbreviation notIde
     where "notIde \<equiv> \<lambda>u. \<not> \<Lambda>.Ide u"
 
     lemma filter_notIde_Ide:
     shows "Ide U \<Longrightarrow> filter notIde U = []"
       by (induct U) auto
 
     lemma cong_filter_notIde:
     shows "\<lbrakk>Arr U; \<not> Ide U\<rbrakk> \<Longrightarrow> filter notIde U \<^sup>*\<sim>\<^sup>* U"
     proof (induct U)
       show "\<lbrakk>Arr []; \<not> Ide []\<rbrakk> \<Longrightarrow> filter notIde [] \<^sup>*\<sim>\<^sup>* []"
         by simp
       fix u U
       assume ind: "\<lbrakk>Arr U; \<not> Ide U\<rbrakk> \<Longrightarrow> filter notIde U \<^sup>*\<sim>\<^sup>* U"
       assume Arr: "Arr (u # U)"
       assume 1: "\<not> Ide (u # U)"
       show "filter notIde (u # U) \<^sup>*\<sim>\<^sup>* (u # U)"
       proof (cases "\<Lambda>.Ide u")
         assume u: "\<Lambda>.Ide u"
         have U: "Arr U \<and> \<not> Ide U"
           using Arr u 1 Ide.elims(3) by fastforce
         have "filter notIde (u # U) = filter notIde U"
           using u by simp
         also have "... \<^sup>*\<sim>\<^sup>* U"
           using U ind by blast
         also have "U \<^sup>*\<sim>\<^sup>* [u] @ U"
           using u
           by (metis (full_types) Arr Arr_has_Src Cons_eq_append_conv Ide.elims(3) Ide.simps(2)
               Srcs.simps(1) U arrI\<^sub>P arr_append_imp_seq cong_append_ideI(3) ide_char
               \<Lambda>.ide_char not_Cons_self2)
         also have "[u] @ U = u # U"
           by simp
         finally show ?thesis by blast
         next
         assume u: "\<not> \<Lambda>.Ide u"
         show ?thesis
         proof (cases "Ide U")
           assume U: "Ide U"
           have "filter notIde (u # U) = [u]"
             using u U filter_notIde_Ide by simp
           moreover have "[u] \<^sup>*\<sim>\<^sup>* [u] @ U"
             using u U cong_append_ideI(4) [of "[u]" U]
             by (metis Arr Con_Arr_self Cons_eq_appendI Resid_Ide(1) arr_append_imp_seq
                 arr_char ide_char ide_implies_arr neq_Nil_conv self_append_conv2)
           moreover have "[u] @ U = u # U"
             by simp
           ultimately show ?thesis by auto
           next
           assume U: "\<not> Ide U"
           have "filter notIde (u # U) = [u] @ filter notIde U"
             using u U Arr by simp
           also have "... \<^sup>*\<sim>\<^sup>* [u] @ U"
           proof (cases "U = []")
             show "U = [] \<Longrightarrow> ?thesis"
               by (metis Arr arr_char cong_reflexive append_Nil2 filter.simps(1))
             assume 1: "U \<noteq> []"
             have "seq [u] (filter notIde U)"
               by (metis (full_types) 1 Arr Arr.simps(2-3) Con_imp_eq_Srcs Con_implies_Arr(1)
                   Ide.elims(3) Ide.simps(1) Trgs.simps(2) U ide_char ind seq_char
                   seq_implies_Trgs_eq_Srcs)
             thus ?thesis
               using u U Arr ind cong_append [of "[u]" "filter notIde U" "[u]" U]
               by (meson 1 Arr_consE cong_reflexive seqE)
           qed
           also have "[u] @ U = u # U"
             by simp
           finally show ?thesis by argo
         qed
       qed
     qed
 
     lemma Std_filter_map_un_App1:
     shows "\<lbrakk>Std U; set U \<subseteq> Collect \<Lambda>.is_App\<rbrakk> \<Longrightarrow> Std (filter notIde (map \<Lambda>.un_App1 U))"
     proof (induct U)
       show "\<lbrakk>Std []; set [] \<subseteq> Collect \<Lambda>.is_App\<rbrakk> \<Longrightarrow> Std (filter notIde (map \<Lambda>.un_App1 []))"
         by simp
       fix u U
       assume ind: "\<lbrakk>Std U; set U \<subseteq> Collect \<Lambda>.is_App\<rbrakk> \<Longrightarrow> Std (filter notIde (map \<Lambda>.un_App1 U))"
       assume 1: "Std (u # U)"
       assume 2: "set (u # U) \<subseteq> Collect \<Lambda>.is_App"
       show "Std (filter notIde (map \<Lambda>.un_App1 (u # U)))"
         using 1 2 ind
         apply (cases u)
             apply simp_all
       proof -
         fix u1 u2
         assume uU: "Std ((u1 \<^bold>\<circ> u2) # U)"
         assume set: "set U \<subseteq> Collect \<Lambda>.is_App"
         assume ind: "Std U \<Longrightarrow> Std (filter notIde (map \<Lambda>.un_App1 U))"
         assume u: "u = u1 \<^bold>\<circ> u2"
         show "(\<not> \<Lambda>.Ide u1 \<longrightarrow> Std (u1 # filter notIde (map \<Lambda>.un_App1 U))) \<and>
               (\<Lambda>.Ide u1 \<longrightarrow> Std (filter notIde (map \<Lambda>.un_App1 U)))"
         proof (intro conjI impI)
           assume u1: "\<Lambda>.Ide u1"
           show "Std (filter notIde (map \<Lambda>.un_App1 U))"
             by (metis 1 Std.simps(1) Std.simps(3) ind neq_Nil_conv)
           next
           assume u1: "\<not> \<Lambda>.Ide u1"
           show "Std (u1 # filter notIde (map \<Lambda>.un_App1 U))"
           proof (cases "Ide (map \<Lambda>.un_App1 U)")
             show "Ide (map \<Lambda>.un_App1 U) \<Longrightarrow> ?thesis"
             proof -
               assume U: "Ide (map \<Lambda>.un_App1 U)"
               have "filter notIde (map \<Lambda>.un_App1 U) = []"
                 by (metis U Ide_char filter_False \<Lambda>.ide_char
                     mem_Collect_eq subsetD)
               thus ?thesis
                 by (metis Std.elims(1) Std.simps(2) \<Lambda>.elementary_reduction.simps(4) list.discI
                     list.sel(1) \<Lambda>.sseq_imp_elementary_reduction1 u1 uU)
             qed
             assume U: "\<not> Ide (map \<Lambda>.un_App1 U)"
             show ?thesis
             proof (cases "U = []")
               show "U = [] \<Longrightarrow> ?thesis"
                 using 1 u u1 by fastforce
               assume "U \<noteq> []"
               hence U: "U \<noteq> [] \<and> \<not> Ide (map \<Lambda>.un_App1 U)"
                 using U by simp
               have "\<Lambda>.sseq u1 (hd (filter notIde (map \<Lambda>.un_App1 U)))"
               proof -
                 have "\<And>u1 u2. \<lbrakk>set U \<subseteq> Collect \<Lambda>.is_App; \<not> Ide (map \<Lambda>.un_App1 U); U \<noteq> [];
                                Std ((u1 \<^bold>\<circ> u2) # U); \<not> \<Lambda>.Ide u1\<rbrakk>
                                    \<Longrightarrow> \<Lambda>.sseq u1 (hd (filter notIde (map \<Lambda>.un_App1 U)))"
                   for U
                   apply (induct U)
                    apply simp_all
                   apply (intro conjI impI)
                 proof -
                   fix u U u1 u2
                   assume ind: "\<And>u1 u2. \<lbrakk>\<not> Ide (map \<Lambda>.un_App1 U); U \<noteq> [];
                                         Std ((u1 \<^bold>\<circ> u2) # U); \<not> \<Lambda>.Ide u1\<rbrakk>
                                           \<Longrightarrow> \<Lambda>.sseq u1 (hd (filter notIde (map \<Lambda>.un_App1 U)))"
                   assume 1: "\<Lambda>.is_App u \<and> set U \<subseteq> Collect \<Lambda>.is_App"
                   assume 2: "\<not> Ide (\<Lambda>.un_App1 u # map \<Lambda>.un_App1 U)"
                   assume 3: "\<Lambda>.sseq (u1 \<^bold>\<circ> u2) u \<and> Std (u # U)"
                   show "\<not> \<Lambda>.Ide (\<Lambda>.un_App1 u) \<Longrightarrow> \<Lambda>.sseq u1 (\<Lambda>.un_App1 u)"
                     by (metis 1 3 \<Lambda>.Arr.simps(4) \<Lambda>.Ide_Trg \<Lambda>.lambda.collapse(3) \<Lambda>.seq_char
                         \<Lambda>.sseq.simps(4) \<Lambda>.sseq_imp_seq)
                   assume 4: "\<not> \<Lambda>.Ide u1"
                   assume 5: "\<Lambda>.Ide (\<Lambda>.un_App1 u)"
                   have u1: "\<Lambda>.elementary_reduction u1"
                     using 3 4 \<Lambda>.elementary_reduction.simps(4) \<Lambda>.sseq_imp_elementary_reduction1
                     by blast
                   have 6: "Arr (\<Lambda>.un_App1 u # map \<Lambda>.un_App1 U)"
                     using 1 3 Std_imp_Arr Arr_map_un_App1 [of "u # U"] by auto
                   have 7: "Arr (map \<Lambda>.un_App1 U)"
                     using 1 2 3 5 6 Arr_map_un_App1 Std_imp_Arr \<Lambda>.ide_char by fastforce
                   have 8: "\<not> Ide (map \<Lambda>.un_App1 U)"
                     using 2 5 6 set_Ide_subset_ide by fastforce
                   have 9: "\<Lambda>.seq u (hd U)"
                     by (metis 3 7 Std.simps(3) Arr.simps(1) list.collapse list.simps(8)
                         \<Lambda>.sseq_imp_seq)
                   show "\<Lambda>.sseq u1 (hd (filter notIde (map \<Lambda>.un_App1 U)))"
                   proof -
                     have "\<Lambda>.sseq (u1 \<^bold>\<circ> \<Lambda>.Trg (\<Lambda>.un_App2 u)) (hd U)"
                     proof (cases "\<Lambda>.Ide (\<Lambda>.un_App1 (hd U))")
                       assume 10: "\<Lambda>.Ide (\<Lambda>.un_App1 (hd U))"
                       hence "\<Lambda>.elementary_reduction (\<Lambda>.un_App2 (hd U))"
                         by (metis (full_types) 1 3 7 Std.elims(2) Arr.simps(1)
                             \<Lambda>.elementary_reduction_App_iff \<Lambda>.elementary_reduction_not_ide
                             \<Lambda>.ide_char list.sel(2) list.sel(3) list.set_sel(1) list.simps(8)
                             mem_Collect_eq \<Lambda>.sseq_imp_elementary_reduction2 subsetD)
                       moreover have "\<Lambda>.Trg u1 = \<Lambda>.un_App1 (hd U)"
                       proof -
                         have "\<Lambda>.Trg u1 = \<Lambda>.Src (\<Lambda>.un_App1 u)"
                           by (metis 1 3 5 \<Lambda>.Ide_iff_Src_self \<Lambda>.Ide_implies_Arr \<Lambda>.Trg_Src
                               \<Lambda>.elementary_reduction_not_ide \<Lambda>.ide_char \<Lambda>.lambda.collapse(3)
                               \<Lambda>.sseq.simps(4) \<Lambda>.sseq_imp_elementary_reduction2)
                         also have "... = \<Lambda>.Trg (\<Lambda>.un_App1 u)"
                           by (metis 5 \<Lambda>.Ide_iff_Src_self \<Lambda>.Ide_iff_Trg_self
                               \<Lambda>.Ide_implies_Arr)
                         also have "... = \<Lambda>.un_App1 (hd U)"
                           using 1 3 5 7 \<Lambda>.Ide_iff_Trg_self
                           by (metis 9 10 Arr.simps(1) lambda_calculus.Ide_iff_Src_self
                               \<Lambda>.Ide_implies_Arr \<Lambda>.Src_Src \<Lambda>.Src_eq_iff(2) \<Lambda>.Trg.simps(3)
                               \<Lambda>.lambda.collapse(3) \<Lambda>.seqE\<^sub>\<Lambda> list.set_sel(1) list.simps(8)
                               mem_Collect_eq subsetD)
                         finally show ?thesis by argo
                       qed
                       moreover have "\<Lambda>.Trg (\<Lambda>.un_App2 u) = \<Lambda>.Src (\<Lambda>.un_App2 (hd U))"
                         by (metis 1 7 9 Arr.simps(1) hd_in_set \<Lambda>.Src.simps(4) \<Lambda>.Src_Src
                             \<Lambda>.Trg.simps(3) \<Lambda>.lambda.collapse(3) \<Lambda>.lambda.sel(4)
                             \<Lambda>.seq_char list.simps(8) mem_Collect_eq subset_code(1))
                       ultimately show ?thesis
                         using \<Lambda>.sseq.simps(4)
                         by (metis 1 7 u1 Arr.simps(1) hd_in_set \<Lambda>.lambda.collapse(3)
                             list.simps(8) mem_Collect_eq subsetD)
                       next
                       assume 10: "\<not> \<Lambda>.Ide (\<Lambda>.un_App1 (hd U))"
                       have False
                       proof -
                         have "\<Lambda>.elementary_reduction (\<Lambda>.un_App2 u)"
                           using 1 3 5 \<Lambda>.elementary_reduction_App_iff
                                 \<Lambda>.elementary_reduction_not_ide \<Lambda>.sseq_imp_elementary_reduction2
                           by blast
                         moreover have "\<Lambda>.sseq u (hd U)"
                           by (metis 3 7 Std.simps(3) Arr.simps(1)
                               hd_Cons_tl list.simps(8))
                         moreover have "\<Lambda>.elementary_reduction (\<Lambda>.un_App1 (hd U))"
                           by (metis 1 7 10 Nil_is_map_conv Arr.simps(1)
                               calculation(2) \<Lambda>.elementary_reduction_App_iff hd_in_set \<Lambda>.ide_char
                               mem_Collect_eq \<Lambda>.sseq_imp_elementary_reduction2 subset_iff)
                         ultimately show ?thesis
                           using \<Lambda>.sseq.simps(4)
                           by (metis 1 5 7 Arr.simps(1) \<Lambda>.elementary_reduction_not_ide
                               hd_in_set \<Lambda>.ide_char \<Lambda>.lambda.collapse(3) list.simps(8)
                               mem_Collect_eq subset_iff)
                       qed
                       thus ?thesis by argo
                     qed
                     hence " Std ((u1 \<^bold>\<circ> \<Lambda>.Trg (\<Lambda>.un_App2 u)) # U)"
                       by (metis 3 7 Std.simps(3) Arr.simps(1) list.exhaust_sel list.simps(8))
                     thus ?thesis
                       using ind
                       by (metis 7 8 u1 Arr.simps(1) \<Lambda>.elementary_reduction_not_ide \<Lambda>.ide_char
                           list.simps(8))
                   qed
                 qed
                 thus ?thesis
                   using U set u1 uU by blast
               qed
               thus ?thesis
                 by (metis 1 Std.simps(2-3) \<open>U \<noteq> []\<close> ind list.exhaust_sel list.sel(1)
                     \<Lambda>.sseq_imp_elementary_reduction1)
             qed
           qed
         qed
       qed
     qed
 
     lemma Std_filter_map_un_App2:
     shows "\<lbrakk>Std U; set U \<subseteq> Collect \<Lambda>.is_App\<rbrakk> \<Longrightarrow> Std (filter notIde (map \<Lambda>.un_App2 U))"
     proof (induct U)
       show "\<lbrakk>Std []; set [] \<subseteq> Collect \<Lambda>.is_App\<rbrakk> \<Longrightarrow> Std (filter notIde (map \<Lambda>.un_App2 []))"
         by simp
       fix u U
       assume ind: "\<lbrakk>Std U; set U \<subseteq> Collect \<Lambda>.is_App\<rbrakk> \<Longrightarrow> Std (filter notIde (map \<Lambda>.un_App2 U))"
       assume 1: "Std (u # U)"
       assume 2: "set (u # U) \<subseteq> Collect \<Lambda>.is_App"
       show "Std (filter notIde (map \<Lambda>.un_App2 (u # U)))"
         using 1 2 ind
         apply (cases u)
             apply simp_all
       proof -
         fix u1 u2
         assume uU: "Std ((u1 \<^bold>\<circ> u2) # U)"
         assume set: "set U \<subseteq> Collect \<Lambda>.is_App"
         assume ind: "Std U \<Longrightarrow> Std (filter notIde (map \<Lambda>.un_App2 U))"
         assume u: "u = u1 \<^bold>\<circ> u2"
         show "(\<not> \<Lambda>.Ide u2 \<longrightarrow> Std (u2 # filter notIde (map \<Lambda>.un_App2 U))) \<and>
               (\<Lambda>.Ide u2 \<longrightarrow> Std (filter notIde (map \<Lambda>.un_App2 U)))"
         proof (intro conjI impI)
           assume u2: "\<Lambda>.Ide u2"
           show "Std (filter notIde (map \<Lambda>.un_App2 U))"
             by (metis 1 Std.simps(1) Std.simps(3) ind neq_Nil_conv)
           next
           assume u2: "\<not> \<Lambda>.Ide u2"
           show "Std (u2 # filter notIde (map \<Lambda>.un_App2 U))"
           proof (cases "Ide (map \<Lambda>.un_App2 U)")
             show "Ide (map \<Lambda>.un_App2 U) \<Longrightarrow> ?thesis"
             proof -
               assume U: "Ide (map \<Lambda>.un_App2 U)"
               have "filter notIde (map \<Lambda>.un_App2 U) = []"
                 by (metis U Ide_char filter_False \<Lambda>.ide_char mem_Collect_eq subsetD)
               thus ?thesis
                 by (metis Std.elims(1) Std.simps(2) \<Lambda>.elementary_reduction.simps(4) list.discI
                     list.sel(1) \<Lambda>.sseq_imp_elementary_reduction1 u2 uU)
             qed
             assume U: "\<not> Ide (map \<Lambda>.un_App2 U)"
             show ?thesis
             proof (cases "U = []")
               show "U = [] \<Longrightarrow> ?thesis"
                 using "1" u u2 by fastforce
               assume "U \<noteq> []"
               hence U: "U \<noteq> [] \<and> \<not> Ide (map \<Lambda>.un_App2 U)"
                 using U by simp
               have "\<Lambda>.sseq u2 (hd (filter notIde (map \<Lambda>.un_App2 U)))"
               proof -
                 have "\<And>u1 u2. \<lbrakk>set U \<subseteq> Collect \<Lambda>.is_App; \<not> Ide (map \<Lambda>.un_App2 U); U \<noteq> [];
                                Std ((u1 \<^bold>\<circ> u2) # U); \<not> \<Lambda>.Ide u2\<rbrakk>
                                    \<Longrightarrow> \<Lambda>.sseq u2 (hd (filter notIde (map \<Lambda>.un_App2 U)))"
                   for U
                   apply (induct U)
                   apply simp_all
                   apply (intro conjI impI)
                 proof -
                   fix u U u1 u2
                   assume ind: "\<And>u1 u2. \<lbrakk>\<not> Ide (map \<Lambda>.un_App2 U); U \<noteq> [];
                                         Std ((u1 \<^bold>\<circ> u2) # U); \<not> \<Lambda>.Ide u2\<rbrakk>
                                           \<Longrightarrow> \<Lambda>.sseq u2 (hd (filter notIde (map \<Lambda>.un_App2 U)))"
                   assume 1: "\<Lambda>.is_App u \<and> set U \<subseteq> Collect \<Lambda>.is_App"
                   assume 2: "\<not> Ide (\<Lambda>.un_App2 u # map \<Lambda>.un_App2 U)"
                   assume 3: "\<Lambda>.sseq (u1 \<^bold>\<circ> u2) u \<and> Std (u # U)"
                   assume 4: "\<not> \<Lambda>.Ide u2"
                   show "\<not> \<Lambda>.Ide (\<Lambda>.un_App2 u) \<Longrightarrow> \<Lambda>.sseq u2 (\<Lambda>.un_App2 u)"
                     by (metis 1 3 4 \<Lambda>.elementary_reduction.simps(4)
                         \<Lambda>.elementary_reduction_not_ide \<Lambda>.ide_char \<Lambda>.lambda.collapse(3)
                         \<Lambda>.sseq.simps(4) \<Lambda>.sseq_imp_elementary_reduction1)
                   assume 5: "\<Lambda>.Ide (\<Lambda>.un_App2 u)"
                   have False
                     by (metis 1 3 4 5 \<Lambda>.elementary_reduction_not_ide \<Lambda>.ide_char
                         \<Lambda>.lambda.collapse(3) \<Lambda>.sseq.simps(4) \<Lambda>.sseq_imp_elementary_reduction2)
                   thus "\<Lambda>.sseq u2 (hd (filter notIde (map \<Lambda>.un_App2 U)))" by argo
                 qed
                 thus ?thesis
                   using U set u2 uU by blast
               qed
               thus ?thesis
                 by (metis "1" Std.simps(2) Std.simps(3) \<open>U \<noteq> []\<close> ind list.exhaust_sel list.sel(1)
                     \<Lambda>.sseq_imp_elementary_reduction1)
             qed
           qed
         qed
       qed
     qed
 
     text \<open>
       If the first step in a standard reduction path contracts a redex that is
       not at the head position, then all subsequent terms have \<open>App\<close> as their
       top-level operator.
     \<close>
 
     lemma seq_App_Std_implies:
-    shows "\<And>t. \<lbrakk>Std (t # U); \<Lambda>.is_App t \<and> \<not> \<Lambda>.contains_head_reduction t\<rbrakk>
-                  \<Longrightarrow> set U \<subseteq> Collect \<Lambda>.is_App"
-    proof (induct U)
+    shows "\<lbrakk>Std (t # U); \<Lambda>.is_App t \<and> \<not> \<Lambda>.contains_head_reduction t\<rbrakk>
+              \<Longrightarrow> set U \<subseteq> Collect \<Lambda>.is_App"
+    proof (induct U arbitrary: t)
       show "\<And>t. \<lbrakk>Std [t]; \<Lambda>.is_App t \<and> \<not> \<Lambda>.contains_head_reduction t\<rbrakk>
                    \<Longrightarrow> set [] \<subseteq> Collect \<Lambda>.is_App"
         by simp
       fix t u U
       assume ind: "\<And>t. \<lbrakk>Std (t # U); \<Lambda>.is_App t \<and> \<not> \<Lambda>.contains_head_reduction t\<rbrakk>
                            \<Longrightarrow> set U \<subseteq> Collect \<Lambda>.is_App"
       assume Std: "Std (t # u # U)"
       assume t: "\<Lambda>.is_App t \<and> \<not> \<Lambda>.contains_head_reduction t"
       have U: "set (u # U) \<subseteq> Collect \<Lambda>.elementary_reduction"
         using Std Std_implies_set_subset_elementary_reduction by fastforce
       have u: "\<Lambda>.elementary_reduction u"
         using U by simp
       have "set U \<subseteq> Collect \<Lambda>.elementary_reduction"
         using U by simp
       show "set (u # U) \<subseteq> Collect \<Lambda>.is_App"
       proof (cases "U = []")
         show "U = [] \<Longrightarrow> ?thesis"
           by (metis Std empty_set empty_subsetI insert_subset
               \<Lambda>.sseq_preserves_App_and_no_head_reduction list.sel(1) list.simps(15)
               mem_Collect_eq reduction_paths.Std.simps(3) t)
         assume U: "U \<noteq> []"
         have "\<Lambda>.sseq t u"
           using Std by auto
         hence "\<Lambda>.is_App u \<and> \<not> \<Lambda>.Ide u \<and> \<not> \<Lambda>.contains_head_reduction u"
           using t u U \<Lambda>.sseq_preserves_App_and_no_head_reduction [of t u]
                 \<Lambda>.elementary_reduction_not_ide
           by blast
         thus ?thesis
           using Std ind [of u] \<open>set U \<subseteq> Collect \<Lambda>.elementary_reduction\<close> by simp
       qed
     qed
 
     subsection "Standard Developments"
 
     text \<open>
       The following function takes a term \<open>t\<close> (representing a parallel reduction)
       and produces a standard reduction path that is a complete development of \<open>t\<close>
       and is thus congruent to \<open>[t]\<close>.  The proof of termination makes use of the
       Finite Development Theorem.
     \<close>
 
     function (sequential) standard_development
     where "standard_development \<^bold>\<sharp> = []"
         | "standard_development \<^bold>\<guillemotleft>_\<^bold>\<guillemotright> = []"
         | "standard_development \<^bold>\<lambda>\<^bold>[t\<^bold>] = map \<Lambda>.Lam (standard_development t)"
         | "standard_development (t \<^bold>\<circ> u) =
            (if \<Lambda>.Arr t \<and> \<Lambda>.Arr u then
               map (\<lambda>v. v \<^bold>\<circ> \<Lambda>.Src u) (standard_development t) @
               map (\<lambda>v. \<Lambda>.Trg t \<^bold>\<circ> v) (standard_development u)
             else [])"
         | "standard_development (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) =
            (if \<Lambda>.Arr t \<and> \<Lambda>.Arr u then
               (\<^bold>\<lambda>\<^bold>[\<Lambda>.Src t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src u) # standard_development (\<Lambda>.subst u t)
             else [])"
       by pat_completeness auto
 
     abbreviation (in lambda_calculus) stddev_term_rel
     where "stddev_term_rel \<equiv> mlex_prod hgt subterm_rel"
 
     lemma (in lambda_calculus) subst_lt_Beta:
     assumes "Arr t" and "Arr u"
     shows "(subst u t, \<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) \<in> stddev_term_rel"
     proof -
       have "(\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) \\ (\<^bold>\<lambda>\<^bold>[Src t\<^bold>] \<^bold>\<Zspot> Src u) = subst u t"
         using assms
         by (metis Arr_not_Nil Ide_Src Ide_iff_Src_self Ide_implies_Arr resid.simps(4)
             resid_Arr_Ide)
       moreover have "elementary_reduction (\<^bold>\<lambda>\<^bold>[Src t\<^bold>] \<^bold>\<Zspot> Src u)"
         by (simp add: assms Ide_Src)
       moreover have "\<^bold>\<lambda>\<^bold>[Src t\<^bold>] \<^bold>\<Zspot> Src u \<sqsubseteq> \<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u"
         by (metis assms Arr.simps(5) head_redex.simps(9) subs_head_redex)
       ultimately show ?thesis
         using assms elementary_reduction_decreases_hgt [of "\<^bold>\<lambda>\<^bold>[Src t\<^bold>] \<^bold>\<Zspot> Src u" "\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u"]
         by (metis mlex_less)
     qed
 
     termination standard_development
     proof (relation \<Lambda>.stddev_term_rel)
       show "wf \<Lambda>.stddev_term_rel"
         using \<Lambda>.wf_subterm_rel wf_mlex by blast
       show "\<And>t. (t, \<^bold>\<lambda>\<^bold>[t\<^bold>]) \<in> \<Lambda>.stddev_term_rel"
         by (simp add: \<Lambda>.subterm_lemmas(1) mlex_prod_def)
       show "\<And>t u. (t, t \<^bold>\<circ> u) \<in> \<Lambda>.stddev_term_rel"
         using \<Lambda>.subterm_lemmas(3)
         by (metis antisym_conv1 \<Lambda>.hgt.simps(4) le_add1 mem_Collect_eq mlex_iff old.prod.case)
       show "\<And>t u. (u, t \<^bold>\<circ> u) \<in> \<Lambda>.stddev_term_rel"
         using \<Lambda>.subterm_lemmas(3) by (simp add: mlex_leq)
       show "\<And>t u. \<Lambda>.Arr t \<and> \<Lambda>.Arr u \<Longrightarrow> (\<Lambda>.subst u t, \<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) \<in> \<Lambda>.stddev_term_rel"
         using \<Lambda>.subst_lt_Beta by simp
     qed
 
     lemma Ide_iff_standard_development_empty:
     shows "\<Lambda>.Arr t \<Longrightarrow> \<Lambda>.Ide t \<longleftrightarrow> standard_development t = []"
       by (induct t) auto
 
     lemma set_standard_development:
     shows "\<Lambda>.Arr t \<longrightarrow> set (standard_development t) \<subseteq> Collect \<Lambda>.elementary_reduction"
       apply (rule standard_development.induct)
       using \<Lambda>.Ide_Src \<Lambda>.Ide_Trg \<Lambda>.Arr_Subst by auto
 
     lemma cong_standard_development:
     shows "\<Lambda>.Arr t \<and> \<not> \<Lambda>.Ide t \<longrightarrow> standard_development t \<^sup>*\<sim>\<^sup>* [t]"
     proof (rule standard_development.induct)
      show "\<Lambda>.Arr \<^bold>\<sharp> \<and> \<not> \<Lambda>.Ide \<^bold>\<sharp> \<longrightarrow> standard_development \<^bold>\<sharp> \<^sup>*\<sim>\<^sup>* [\<^bold>\<sharp>]"
         by simp
       show "\<And>x. \<Lambda>.Arr \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<and> \<not> \<Lambda>.Ide \<^bold>\<guillemotleft>x\<^bold>\<guillemotright>
                   \<longrightarrow> standard_development \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^sup>*\<sim>\<^sup>* [\<^bold>\<guillemotleft>x\<^bold>\<guillemotright>]"
         by simp
       show "\<And>t. \<Lambda>.Arr t \<and> \<not> \<Lambda>.Ide t \<longrightarrow> standard_development t \<^sup>*\<sim>\<^sup>* [t] \<Longrightarrow>
                 \<Lambda>.Arr \<^bold>\<lambda>\<^bold>[t\<^bold>] \<and> \<not> \<Lambda>.Ide \<^bold>\<lambda>\<^bold>[t\<^bold>] \<longrightarrow> standard_development \<^bold>\<lambda>\<^bold>[t\<^bold>] \<^sup>*\<sim>\<^sup>* [\<^bold>\<lambda>\<^bold>[t\<^bold>]]"
         by (metis (mono_tags, lifting) cong_map_Lam \<Lambda>.Arr.simps(3) \<Lambda>.Ide.simps(3)
             list.simps(8,9) standard_development.simps(3))
       show "\<And>t u. \<lbrakk>\<Lambda>.Arr t \<and> \<Lambda>.Arr u
                      \<Longrightarrow> \<Lambda>.Arr t \<and> \<not> \<Lambda>.Ide t \<longrightarrow> standard_development t \<^sup>*\<sim>\<^sup>* [t];
                    \<Lambda>.Arr t \<and> \<Lambda>.Arr u
                      \<Longrightarrow> \<Lambda>.Arr u \<and> \<not> \<Lambda>.Ide u \<longrightarrow> standard_development u \<^sup>*\<sim>\<^sup>* [u]\<rbrakk>
                        \<Longrightarrow> \<Lambda>.Arr (t \<^bold>\<circ> u) \<and> \<not> \<Lambda>.Ide (t \<^bold>\<circ> u) \<longrightarrow>
                              standard_development (t \<^bold>\<circ> u) \<^sup>*\<sim>\<^sup>* [t \<^bold>\<circ> u]"
       proof
         fix t u
         assume ind1: "\<Lambda>.Arr t \<and> \<Lambda>.Arr u
                         \<Longrightarrow> \<Lambda>.Arr t \<and> \<not> \<Lambda>.Ide t \<longrightarrow> standard_development t \<^sup>*\<sim>\<^sup>* [t]"
         assume ind2: "\<Lambda>.Arr t \<and> \<Lambda>.Arr u
                         \<Longrightarrow> \<Lambda>.Arr u \<and> \<not> \<Lambda>.Ide u \<longrightarrow> standard_development u \<^sup>*\<sim>\<^sup>* [u]"
         assume 1: "\<Lambda>.Arr (t \<^bold>\<circ> u) \<and> \<not> \<Lambda>.Ide (t \<^bold>\<circ> u)"
         show "standard_development (t \<^bold>\<circ> u) \<^sup>*\<sim>\<^sup>* [t \<^bold>\<circ> u]"
         proof (cases "standard_development t = []")
           show "standard_development t = [] \<Longrightarrow> ?thesis"
             using 1 ind2 cong_map_App1 Ide_iff_standard_development_empty \<Lambda>.Ide_iff_Trg_self
             apply simp
             by (metis (no_types, opaque_lifting) list.simps(8,9))
           assume t: "standard_development t \<noteq> []"
           show ?thesis
           proof (cases "standard_development u = []")
             assume u: "standard_development u = []"
             have "standard_development (t \<^bold>\<circ> u) = map (\<lambda>X. X \<^bold>\<circ> u) (standard_development t)"
               using u 1 \<Lambda>.Ide_iff_Src_self ide_char ind2 by auto
             also have "... \<^sup>*\<sim>\<^sup>* map (\<lambda>a. a \<^bold>\<circ> u) [t]"
               using cong_map_App2 [of u]
               by (meson 1 \<Lambda>.Arr.simps(4) Ide_iff_standard_development_empty t u ind1)
             also have "map (\<lambda>a. a \<^bold>\<circ> u) [t] = [t \<^bold>\<circ> u]"
               by simp
             finally show ?thesis by blast
             next
             assume u: "standard_development u \<noteq> []"
             have "standard_development (t \<^bold>\<circ> u) =
                   map (\<lambda>a. a \<^bold>\<circ> \<Lambda>.Src u) (standard_development t) @
                   map (\<lambda>b. \<Lambda>.Trg t \<^bold>\<circ> b) (standard_development u)"
               using 1 by force
             moreover have "map (\<lambda>a. a \<^bold>\<circ> \<Lambda>.Src u) (standard_development t) \<^sup>*\<sim>\<^sup>* [t \<^bold>\<circ> \<Lambda>.Src u]"
             proof -
               have "map (\<lambda>a. a \<^bold>\<circ> \<Lambda>.Src u) (standard_development t) \<^sup>*\<sim>\<^sup>* map (\<lambda>a. a \<^bold>\<circ> \<Lambda>.Src u) [t]"
                 using t u 1 ind1 \<Lambda>.Ide_Src Ide_iff_standard_development_empty cong_map_App2
                 by (metis \<Lambda>.Arr.simps(4))
               also have "map (\<lambda>a. a \<^bold>\<circ> \<Lambda>.Src u) [t] = [t \<^bold>\<circ> \<Lambda>.Src u]"
                 by simp
               finally show ?thesis by blast
             qed
             moreover have "map (\<lambda>b. \<Lambda>.Trg t \<^bold>\<circ> b) (standard_development u) \<^sup>*\<sim>\<^sup>* [\<Lambda>.Trg t \<^bold>\<circ> u]"
               using t u 1 ind2 \<Lambda>.Ide_Trg Ide_iff_standard_development_empty cong_map_App1
               by (metis (mono_tags, opaque_lifting) \<Lambda>.Arr.simps(4) list.simps(8,9))
             moreover have "seq (map (\<lambda>a. a \<^bold>\<circ> \<Lambda>.Src u) (standard_development t))
                                (map (\<lambda>b. \<Lambda>.Trg t \<^bold>\<circ> b) (standard_development u))"
               using 1 u seqI\<^sub>\<Lambda>\<^sub>P Con_implies_Arr(1) Ide.simps(1) calculation(2) ide_char
                     Ide_iff_standard_development_empty Src_hd_eqI Trg_last_eqI
                     calculation(2-3) hd_map ind2 \<Lambda>.Arr.simps(4) \<Lambda>.Src.simps(4)
                     \<Lambda>.Src_Trg \<Lambda>.Trg.simps(3) \<Lambda>.Trg_Src last_ConsL list.sel(1)
               by (metis (no_types, lifting))
             ultimately have "standard_development (t \<^bold>\<circ> u) \<^sup>*\<sim>\<^sup>* [t \<^bold>\<circ> \<Lambda>.Src u] @ [\<Lambda>.Trg t \<^bold>\<circ> u]"
               using cong_append [of "map (\<lambda>a. a \<^bold>\<circ> \<Lambda>.Src u) (standard_development t)"
                                     "map (\<lambda>b. \<Lambda>.Trg t \<^bold>\<circ> b) (standard_development u)"
                                     "[t \<^bold>\<circ> \<Lambda>.Src u]" "[\<Lambda>.Trg t \<^bold>\<circ> u]"]
               by simp
             moreover have "[t \<^bold>\<circ> \<Lambda>.Src u] @ [\<Lambda>.Trg t \<^bold>\<circ> u] \<^sup>*\<sim>\<^sup>* [t \<^bold>\<circ> u]"
               using 1 \<Lambda>.Ide_Trg \<Lambda>.resid_Arr_Src \<Lambda>.resid_Arr_self \<Lambda>.null_char
                     ide_char \<Lambda>.Arr_not_Nil
               by simp
             ultimately show ?thesis
               using cong_transitive by blast
           qed
         qed
       qed
       show "\<And>t u. (\<Lambda>.Arr t \<and> \<Lambda>.Arr u \<Longrightarrow>
                      \<Lambda>.Arr (\<Lambda>.subst u t) \<and> \<not> \<Lambda>.Ide (\<Lambda>.subst u t)
                          \<longrightarrow> standard_development (\<Lambda>.subst u t) \<^sup>*\<sim>\<^sup>* [\<Lambda>.subst u t]) \<Longrightarrow>
                    \<Lambda>.Arr (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) \<and> \<not> \<Lambda>.Ide (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) \<longrightarrow>
                      standard_development (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) \<^sup>*\<sim>\<^sup>* [\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u]"
       proof
         fix t u
         assume 1: "\<Lambda>.Arr (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) \<and> \<not> \<Lambda>.Ide (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u)"
         assume ind: "\<Lambda>.Arr t \<and> \<Lambda>.Arr u \<Longrightarrow>
                        \<Lambda>.Arr (\<Lambda>.subst u t) \<and> \<not> \<Lambda>.Ide (\<Lambda>.subst u t)
                           \<longrightarrow> standard_development (\<Lambda>.subst u t) \<^sup>*\<sim>\<^sup>* [\<Lambda>.subst u t]"
         show "standard_development (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) \<^sup>*\<sim>\<^sup>* [\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u]"
         proof (cases "\<Lambda>.Ide (\<Lambda>.subst u t)")
           assume 2: "\<Lambda>.Ide (\<Lambda>.subst u t)"
           have "standard_development (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) = [\<^bold>\<lambda>\<^bold>[\<Lambda>.Src t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src u]"
             using 1 2 Ide_iff_standard_development_empty [of "\<Lambda>.subst u t"] \<Lambda>.Arr_Subst
             by simp
           also have "[\<^bold>\<lambda>\<^bold>[\<Lambda>.Src t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src u] \<^sup>*\<sim>\<^sup>* [\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u]"
             using 1 2 \<Lambda>.Ide_Src \<Lambda>.Ide_implies_Arr ide_char \<Lambda>.resid_Arr_Ide
             apply (intro conjI)
              apply simp_all
              apply (metis \<Lambda>.Ide.simps(1) \<Lambda>.Ide_Subst_iff \<Lambda>.Ide_Trg)
             by fastforce
           finally show ?thesis by blast
           next
           assume 2: "\<not> \<Lambda>.Ide (\<Lambda>.subst u t)"
           have "standard_development (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) =
                 [\<^bold>\<lambda>\<^bold>[\<Lambda>.Src t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src u] @ standard_development (\<Lambda>.subst u t)"
             using 1 by auto
           also have "[\<^bold>\<lambda>\<^bold>[\<Lambda>.Src t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src u] @ standard_development (\<Lambda>.subst u t) \<^sup>*\<sim>\<^sup>*
                      [\<^bold>\<lambda>\<^bold>[\<Lambda>.Src t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src u] @ [\<Lambda>.subst u t]"
           proof (intro cong_append)
             show "seq [\<Lambda>.Beta (\<Lambda>.Src t) (\<Lambda>.Src u)] (standard_development (\<Lambda>.subst u t))"
               using 1 2 ind arr_char ide_implies_arr \<Lambda>.Arr_Subst Con_implies_Arr(1) Src_hd_eqI
               apply (intro seqI\<^sub>\<Lambda>\<^sub>P)
                 apply simp_all
               by (metis Arr.simps(1))
             show "[\<^bold>\<lambda>\<^bold>[\<Lambda>.Src t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src u] \<^sup>*\<sim>\<^sup>* [\<^bold>\<lambda>\<^bold>[\<Lambda>.Src t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src u]"
               using 1
               by (metis \<Lambda>.Arr.simps(5) \<Lambda>.Ide_Src \<Lambda>.Ide_implies_Arr Arr.simps(2) Resid_Arr_self
                   ide_char \<Lambda>.arr_char)
             show "standard_development (\<Lambda>.subst u t) \<^sup>*\<sim>\<^sup>* [\<Lambda>.subst u t]"
               using 1 2 \<Lambda>.Arr_Subst ind by simp
           qed
           also have "[\<^bold>\<lambda>\<^bold>[\<Lambda>.Src t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src u] @ [\<Lambda>.subst u t] \<^sup>*\<sim>\<^sup>* [\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u]"
           proof
             show "[\<^bold>\<lambda>\<^bold>[\<Lambda>.Src t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src u] @ [\<Lambda>.subst u t] \<^sup>*\<lesssim>\<^sup>* [\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u]"
             proof -
               have "t \\ \<Lambda>.Src t \<noteq> \<^bold>\<sharp> \<and> u \\ \<Lambda>.Src u \<noteq> \<^bold>\<sharp>"
                 by (metis "1" \<Lambda>.Arr.simps(5) \<Lambda>.Coinitial_iff_Con \<Lambda>.Ide_Src \<Lambda>.Ide_iff_Src_self
                     \<Lambda>.Ide_implies_Arr)
               moreover have "\<Lambda>.con (\<^bold>\<lambda>\<^bold>[\<Lambda>.Src t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src u) (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u)"
                 by (metis "1" \<Lambda>.head_redex.simps(9) \<Lambda>.prfx_implies_con \<Lambda>.subs_head_redex
                     \<Lambda>.subs_implies_prfx)
               ultimately have "([\<^bold>\<lambda>\<^bold>[\<Lambda>.Src t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src u] @ [\<Lambda>.subst u t]) \<^sup>*\\\<^sup>* [\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u] =
                                [\<^bold>\<lambda>\<^bold>[\<Lambda>.Src t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src u] \<^sup>*\\\<^sup>* [\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u] @
                                  [\<Lambda>.subst u t] \<^sup>*\\\<^sup>* ([\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u] \<^sup>*\\\<^sup>* [\<^bold>\<lambda>\<^bold>[\<Lambda>.Src t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src u])"
                 using Resid_append(1)
                         [of "[\<^bold>\<lambda>\<^bold>[\<Lambda>.Src t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src u]" "[\<Lambda>.subst u t]" "[\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u]"]
                 apply simp
                 by (metis \<Lambda>.Arr_Subst \<Lambda>.Coinitial_iff_Con \<Lambda>.Ide_Src \<Lambda>.resid_Arr_Ide)
               also have "... = [\<Lambda>.subst (\<Lambda>.Trg u) (\<Lambda>.Trg t)] @ ([\<Lambda>.subst u t] \<^sup>*\\\<^sup>* [\<Lambda>.subst u t])"
               proof -
                 have "t \\ \<Lambda>.Src t \<noteq> \<^bold>\<sharp> \<and> u \\ \<Lambda>.Src u \<noteq> \<^bold>\<sharp>"
                   by (metis "1" \<Lambda>.Arr.simps(5) \<Lambda>.Coinitial_iff_Con \<Lambda>.Ide_Src
                       \<Lambda>.Ide_iff_Src_self \<Lambda>.Ide_implies_Arr)
                 moreover have "\<Lambda>.Src t \\ t \<noteq> \<^bold>\<sharp> \<and> \<Lambda>.Src u \\ u \<noteq> \<^bold>\<sharp>"
                   using \<Lambda>.Con_sym calculation(1) by presburger
                 moreover have "\<Lambda>.con (\<Lambda>.subst u t) (\<Lambda>.subst u t)"
                   by (meson \<Lambda>.Arr_Subst \<Lambda>.Con_implies_Arr2 \<Lambda>.arr_char \<Lambda>.arr_def calculation(2))
                 moreover have "\<Lambda>.con (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) (\<^bold>\<lambda>\<^bold>[\<Lambda>.Src t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src u)"
                   using \<open>\<Lambda>.con (\<^bold>\<lambda>\<^bold>[\<Lambda>.Src t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src u) (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u)\<close> \<Lambda>.con_sym by blast
                 moreover have "\<Lambda>.con (\<^bold>\<lambda>\<^bold>[\<Lambda>.Src t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src u) (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u)"
                   using \<open>\<Lambda>.con (\<^bold>\<lambda>\<^bold>[\<Lambda>.Src t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src u) (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u)\<close> by blast
                 moreover have "\<Lambda>.con (\<Lambda>.subst u t) (\<Lambda>.subst (u \\ \<Lambda>.Src u) (t \\ \<Lambda>.Src t))"
                   by (metis \<Lambda>.Coinitial_iff_Con \<Lambda>.Ide_Src calculation(1-3) \<Lambda>.resid_Arr_Ide)
                 ultimately show ?thesis
                   using "1" by auto
               qed
               finally have "([\<^bold>\<lambda>\<^bold>[\<Lambda>.Src t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src u] @ [\<Lambda>.subst u t]) \<^sup>*\\\<^sup>* [\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u] =
                             [\<Lambda>.subst (\<Lambda>.Trg u) (\<Lambda>.Trg t)] @ [\<Lambda>.subst u t] \<^sup>*\\\<^sup>* [\<Lambda>.subst u t]"
                 by blast
               moreover have "Ide ..."
                 by (metis "1" "2" \<Lambda>.Arr.simps(5) \<Lambda>.Arr_Subst \<Lambda>.Ide_Subst \<Lambda>.Ide_Trg
                     Nil_is_append_conv Arr_append_iff\<^sub>P\<^sub>W\<^sub>E Con_implies_Arr(2) Ide.simps(1-2)
                     Ide_appendI\<^sub>P\<^sub>W\<^sub>E Resid_Arr_self ide_char calculation \<Lambda>.ide_char ind
                     Con_imp_Arr_Resid)
               ultimately show ?thesis
                 using ide_char by presburger
             qed
             show "[\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u] \<^sup>*\<lesssim>\<^sup>* [\<^bold>\<lambda>\<^bold>[\<Lambda>.Src t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src u] @ [\<Lambda>.subst u t]"
             proof -
               have "[\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u] \<^sup>*\\\<^sup>* ([\<^bold>\<lambda>\<^bold>[\<Lambda>.Src t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src u] @ [\<Lambda>.subst u t]) =
                     ([\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u] \<^sup>*\\\<^sup>* [\<^bold>\<lambda>\<^bold>[\<Lambda>.Src t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src u]) \<^sup>*\\\<^sup>* [\<Lambda>.subst u t]"
                 by fastforce
               also have "... = [\<Lambda>.subst u t] \<^sup>*\\\<^sup>* [\<Lambda>.subst u t]"
               proof -
                 have "t \\ \<Lambda>.Src t \<noteq> \<^bold>\<sharp> \<and> u \\ \<Lambda>.Src u \<noteq> \<^bold>\<sharp>"
                   by (metis "1" \<Lambda>.Arr.simps(5) \<Lambda>.Coinitial_iff_Con \<Lambda>.Ide_Src
                       \<Lambda>.Ide_iff_Src_self \<Lambda>.Ide_implies_Arr)
                 moreover have "\<Lambda>.con (\<Lambda>.subst u t) (\<Lambda>.subst u t)"
                   by (metis "1" \<Lambda>.Arr.simps(5) \<Lambda>.Arr_Subst \<Lambda>.Coinitial_iff_Con
                       \<Lambda>.con_def \<Lambda>.null_char)
                 moreover have "\<Lambda>.con (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) (\<^bold>\<lambda>\<^bold>[\<Lambda>.Src t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src u)"
                   by (metis "1" \<Lambda>.Con_sym \<Lambda>.con_def \<Lambda>.head_redex.simps(9) \<Lambda>.null_char
                       \<Lambda>.prfx_implies_con \<Lambda>.subs_head_redex \<Lambda>.subs_implies_prfx)
                 moreover have "\<Lambda>.con (\<Lambda>.subst (u \\ \<Lambda>.Src u) (t \\ \<Lambda>.Src t)) (\<Lambda>.subst u t)"
                   by (metis \<Lambda>.Coinitial_iff_Con \<Lambda>.Ide_Src calculation(1) calculation(2)
                       \<Lambda>.resid_Arr_Ide)
                 ultimately show ?thesis
                   using \<Lambda>.resid_Arr_Ide
                   apply simp
                   by (metis \<Lambda>.Coinitial_iff_Con \<Lambda>.Ide_Src)
               qed
               finally have "[\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u] \<^sup>*\\\<^sup>* ([\<^bold>\<lambda>\<^bold>[\<Lambda>.Src t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src u] @ [\<Lambda>.subst u t]) =
                             [\<Lambda>.subst u t] \<^sup>*\\\<^sup>* [\<Lambda>.subst u t]"
                 by blast
               moreover have "Ide ..."
                 by (metis "1" "2" \<Lambda>.Arr.simps(5) \<Lambda>.Arr_Subst Con_implies_Arr(2) Resid_Arr_self
                     ind ide_char)
               ultimately show ?thesis
                 using ide_char by presburger
             qed
           qed
           finally show ?thesis by blast
         qed
       qed
     qed
 
     lemma Src_hd_standard_development:
     assumes "\<Lambda>.Arr t" and "\<not> \<Lambda>.Ide t"
     shows "\<Lambda>.Src (hd (standard_development t)) = \<Lambda>.Src t"
       by (metis assms Src_hd_eqI cong_standard_development list.sel(1))
 
     lemma Trg_last_standard_development:
     assumes "\<Lambda>.Arr t" and "\<not> \<Lambda>.Ide t"
     shows "\<Lambda>.Trg (last (standard_development t)) = \<Lambda>.Trg t"
       by (metis assms Trg_last_eqI cong_standard_development last_ConsL)
 
     lemma Srcs_standard_development:
     shows "\<lbrakk>\<Lambda>.Arr t; standard_development t \<noteq> []\<rbrakk>
               \<Longrightarrow> Srcs (standard_development t) = {\<Lambda>.Src t}"
       by (metis Con_implies_Arr(1) Ide.simps(1) Ide_iff_standard_development_empty
           Src_hd_standard_development Srcs_simp\<^sub>\<Lambda>\<^sub>P cong_standard_development ide_char)
 
     lemma Trgs_standard_development:
     shows "\<lbrakk>\<Lambda>.Arr t; standard_development t \<noteq> []\<rbrakk>
               \<Longrightarrow> Trgs (standard_development t) = {\<Lambda>.Trg t}"
       by (metis Con_implies_Arr(2) Ide.simps(1) Ide_iff_standard_development_empty
           Trg_last_standard_development Trgs_simp\<^sub>\<Lambda>\<^sub>P cong_standard_development ide_char)
 
     lemma development_standard_development:
     shows "\<Lambda>.Arr t \<longrightarrow> development t (standard_development t)"
       apply (rule standard_development.induct)
           apply blast
          apply simp
         apply (simp add: development_map_Lam)
     proof
       fix t1 t2
       assume ind1: "\<Lambda>.Arr t1 \<and> \<Lambda>.Arr t2
                        \<Longrightarrow> \<Lambda>.Arr t1 \<longrightarrow> development t1 (standard_development t1)"
       assume ind2: "\<Lambda>.Arr t1 \<and> \<Lambda>.Arr t2
                        \<Longrightarrow> \<Lambda>.Arr t2 \<longrightarrow> development t2 (standard_development t2)"
       assume t: "\<Lambda>.Arr (t1 \<^bold>\<circ> t2)"
       show "development (t1 \<^bold>\<circ> t2) (standard_development (t1 \<^bold>\<circ> t2))"
       proof (cases "standard_development t1 = []")
         show "standard_development t1 = []
                 \<Longrightarrow> development (t1 \<^bold>\<circ> t2) (standard_development (t1 \<^bold>\<circ> t2))"
           using t ind2 \<Lambda>.Ide_Src \<Lambda>.Ide_Trg \<Lambda>.Ide_iff_Src_self \<Lambda>.Ide_iff_Trg_self
                 Ide_iff_standard_development_empty
                 development_map_App_2 [of "\<Lambda>.Src t1" t2 "standard_development t2"]
           by fastforce
         assume t1: "standard_development t1 \<noteq> []"
         show "development (t1 \<^bold>\<circ> t2) (standard_development (t1 \<^bold>\<circ> t2))"
         proof (cases "standard_development t2 = []")
           assume t2: "standard_development t2 = []"
           show ?thesis
             using t t2 ind1 Ide_iff_standard_development_empty development_map_App_1 by simp
           next
           assume t2: "standard_development t2 \<noteq> []"
           have "development (t1 \<^bold>\<circ> t2) (map (\<lambda>a. a \<^bold>\<circ> \<Lambda>.Src t2) (standard_development t1))"
             using \<Lambda>.Arr.simps(4) development_map_App_1 ind1 t by presburger
           moreover have "development ((t1 \<^bold>\<circ> t2) \<^sup>1\\\<^sup>*
                                         map (\<lambda>a. a \<^bold>\<circ> \<Lambda>.Src t2) (standard_development t1))
                                      (map (\<lambda>a. \<Lambda>.Trg t1 \<^bold>\<circ> a) (standard_development t2))"
           proof -
             have "\<Lambda>.App t1 t2 \<^sup>1\\\<^sup>* map (\<lambda>a. a \<^bold>\<circ> \<Lambda>.Src t2) (standard_development t1) =
                   \<Lambda>.Trg t1 \<^bold>\<circ> t2"
             proof -
               have "map (\<lambda>a. a \<^bold>\<circ> \<Lambda>.Src t2) (standard_development t1) \<^sup>*\<sim>\<^sup>* [t1 \<^bold>\<circ> \<Lambda>.Src t2]"
               proof -
                 have "map (\<lambda>a. a \<^bold>\<circ> \<Lambda>.Src t2) (standard_development t1) =
                       standard_development (t1 \<^bold>\<circ> \<Lambda>.Src t2)"
                   by (metis \<Lambda>.Arr.simps(4) \<Lambda>.Ide_Src \<Lambda>.Ide_iff_Src_self
                       Ide_iff_standard_development_empty \<Lambda>.Ide_implies_Arr Nil_is_map_conv
                       append_Nil2 standard_development.simps(4) t)
                 also have "standard_development (t1 \<^bold>\<circ> \<Lambda>.Src t2) \<^sup>*\<sim>\<^sup>* [t1 \<^bold>\<circ> \<Lambda>.Src t2]"
                   by (metis \<Lambda>.Arr.simps(4) \<Lambda>.Ide.simps(4) \<Lambda>.Ide_Src \<Lambda>.Ide_implies_Arr
                       cong_standard_development development_Ide ind1 t t1)
                 finally show ?thesis by blast
               qed
               hence "[t1 \<^bold>\<circ> t2] \<^sup>*\\\<^sup>* map (\<lambda>a. a \<^bold>\<circ> \<Lambda>.Src t2) (standard_development t1) =
                      [t1 \<^bold>\<circ> t2] \<^sup>*\\\<^sup>* [t1 \<^bold>\<circ> \<Lambda>.Src t2]"
                 by (metis Resid_parallel con_imp_coinitial prfx_implies_con calculation
                     development_implies map_is_Nil_conv t1)
               also have "[t1 \<^bold>\<circ> t2] \<^sup>*\\\<^sup>* [t1 \<^bold>\<circ> \<Lambda>.Src t2] = [\<Lambda>.Trg t1 \<^bold>\<circ> t2]"
                 using t \<Lambda>.arr_resid_iff_con \<Lambda>.resid_Arr_self
                 by simp force
               finally have "[t1 \<^bold>\<circ> t2] \<^sup>*\\\<^sup>* map (\<lambda>a. a \<^bold>\<circ> \<Lambda>.Src t2) (standard_development t1) =
                             [\<Lambda>.Trg t1 \<^bold>\<circ> t2]"
                 by blast
               thus ?thesis
                 by (simp add: Resid1x_as_Resid')
             qed
             thus ?thesis
               by (metis ind2 \<Lambda>.Arr.simps(4) \<Lambda>.Ide_Trg \<Lambda>.Ide_iff_Src_self development_map_App_2
                   \<Lambda>.reduction_strategy_def \<Lambda>.head_strategy_is_reduction_strategy t)
           qed
           ultimately show ?thesis
             using t development_append [of "t1 \<^bold>\<circ> t2"
                                            "map (\<lambda>a. a \<^bold>\<circ> \<Lambda>.Src t2) (standard_development t1)"
                                            "map (\<lambda>b. \<Lambda>.Trg t1 \<^bold>\<circ> b) (standard_development t2)"]
             by auto
         qed
       qed
       next
       fix t1 t2
       assume ind: "\<Lambda>.Arr t1 \<and> \<Lambda>.Arr t2 \<Longrightarrow>
                      \<Lambda>.Arr (\<Lambda>.subst t2 t1)
                         \<longrightarrow> development (\<Lambda>.subst t2 t1) (standard_development (\<Lambda>.subst t2 t1))"
       show "\<Lambda>.Arr (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) \<longrightarrow> development (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) (standard_development (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2))"
       proof
         assume 1: "\<Lambda>.Arr (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)"
         have "development (\<Lambda>.subst t2 t1) (standard_development (\<Lambda>.subst t2 t1))"
           using 1 ind by (simp add: \<Lambda>.Arr_Subst)
         thus "development (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) (standard_development (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2))"
           using 1 \<Lambda>.Ide_Src \<Lambda>.subs_Ide by auto
       qed
     qed
 
     lemma Std_standard_development:
     shows "Std (standard_development t)"
       apply (rule standard_development.induct)
           apply simp_all
       using Std_map_Lam
         apply blast
     proof
       fix t u
       assume t: "\<Lambda>.Arr t \<and> \<Lambda>.Arr u \<Longrightarrow> Std (standard_development t)"
       assume u: "\<Lambda>.Arr t \<and> \<Lambda>.Arr u \<Longrightarrow> Std (standard_development u)"
       assume 0: "\<Lambda>.Arr t \<and> \<Lambda>.Arr u"
       show "Std (map (\<lambda>a. a \<^bold>\<circ> \<Lambda>.Src u) (standard_development t) @
                  map (\<lambda>b. \<Lambda>.Trg t \<^bold>\<circ> b) (standard_development u))"
       proof (cases "\<Lambda>.Ide t")
         show "\<Lambda>.Ide t \<Longrightarrow> ?thesis"
           using 0 \<Lambda>.Ide_iff_Trg_self Ide_iff_standard_development_empty u Std_map_App2
           by fastforce
         assume 1: "\<not> \<Lambda>.Ide t"
         show ?thesis
         proof (cases "\<Lambda>.Ide u")
           show "\<Lambda>.Ide u \<Longrightarrow> ?thesis"
             using t u 0 1 Std_map_App1 [of "\<Lambda>.Src u" "standard_development t"] \<Lambda>.Ide_Src
             by (metis Ide_iff_standard_development_empty append_Nil2 list.simps(8))
           assume 2: "\<not> \<Lambda>.Ide u"
           show ?thesis
           proof (intro Std_append)
             show 3: "Std (map (\<lambda>a. a \<^bold>\<circ> \<Lambda>.Src u) (standard_development t))"
               using t 0 Std_map_App1 \<Lambda>.Ide_Src by blast
             show "Std (map (\<lambda>b. \<Lambda>.Trg t \<^bold>\<circ> b) (standard_development u))"
               using u 0 Std_map_App2 \<Lambda>.Ide_Trg by simp
             show "map (\<lambda>a. a \<^bold>\<circ> \<Lambda>.Src u) (standard_development t) = [] \<or>
                   map (\<lambda>b. \<Lambda>.Trg t \<^bold>\<circ> b) (standard_development u) = [] \<or>
                   \<Lambda>.sseq (last (map (\<lambda>a. a \<^bold>\<circ> \<Lambda>.Src u) (standard_development t)))
                        (hd (map (\<lambda>b. \<Lambda>.Trg t \<^bold>\<circ> b) (standard_development u)))"
             proof -
               have "\<Lambda>.sseq (last (map (\<lambda>a. a \<^bold>\<circ> \<Lambda>.Src u) (standard_development t)))
                            (hd (map (\<lambda>b. \<Lambda>.Trg t \<^bold>\<circ> b) (standard_development u)))"
               proof -
                 obtain x where x: "last (map (\<lambda>a. a \<^bold>\<circ> \<Lambda>.Src u) (standard_development t)) =
                                    x \<^bold>\<circ> \<Lambda>.Src u"
                   using 0 1 Ide_iff_standard_development_empty last_map by auto
                 obtain y where y: "hd (map (\<lambda>b. \<Lambda>.Trg t \<^bold>\<circ> b) (standard_development u)) =
                                    \<Lambda>.Trg t \<^bold>\<circ> y"
                   using 0 2 Ide_iff_standard_development_empty list.map_sel(1) by auto
                 have "\<Lambda>.elementary_reduction x"
                 proof -
                   have "\<Lambda>.elementary_reduction (x \<^bold>\<circ> \<Lambda>.Src u)"
                     using x
                     by (metis 0 1 3 Ide_iff_standard_development_empty Nil_is_map_conv Std.simps(2)
                         Std_imp_sseq_last_hd append_butlast_last_id append_self_conv2 list.discI
                         list.sel(1) \<Lambda>.sseq_imp_elementary_reduction2)
                   thus ?thesis
                     using 0 \<Lambda>.Ide_Src \<Lambda>.elementary_reduction_not_ide by auto
                 qed
                 moreover have "\<Lambda>.elementary_reduction y"
                 proof -
                   have "\<Lambda>.elementary_reduction (\<Lambda>.Trg t \<^bold>\<circ> y)"
                     using y
                     by (metis 0 2 \<Lambda>.Ide_Trg Ide_iff_standard_development_empty
                         u Std.elims(2) \<Lambda>.elementary_reduction.simps(4) list.map_sel(1) list.sel(1)
                         \<Lambda>.sseq_imp_elementary_reduction1)
                   thus ?thesis
                     using 0 \<Lambda>.Ide_Trg \<Lambda>.elementary_reduction_not_ide by auto
                 qed
                 moreover have "\<Lambda>.Trg t = \<Lambda>.Trg x"
                   by (metis 0 1 Ide_iff_standard_development_empty Trg_last_standard_development
                       x \<Lambda>.lambda.inject(3) last_map)
                 moreover have "\<Lambda>.Src u = \<Lambda>.Src y"
                   using y
                   by (metis 0 2 \<Lambda>.Arr_not_Nil \<Lambda>.Coinitial_iff_Con
                       Ide_iff_standard_development_empty development.elims(2) development_imp_Arr
                       development_standard_development \<Lambda>.lambda.inject(3) list.map_sel(1)
                       list.sel(1))
                 ultimately show ?thesis
                   using x y by simp
               qed
               thus ?thesis by blast
             qed
           qed
         qed
       qed
       next
       fix t u
       assume ind: "\<Lambda>.Arr t \<and> \<Lambda>.Arr u \<Longrightarrow> Std (standard_development (\<Lambda>.subst u t))"
       show "\<Lambda>.Arr t \<and> \<Lambda>.Arr u
               \<longrightarrow> Std ((\<^bold>\<lambda>\<^bold>[\<Lambda>.Src t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src u) # standard_development (\<Lambda>.subst u t))"
       proof
         assume 1: "\<Lambda>.Arr t \<and> \<Lambda>.Arr u"
         show "Std ((\<^bold>\<lambda>\<^bold>[\<Lambda>.Src t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src u) # standard_development (\<Lambda>.subst u t))"
         proof (cases "\<Lambda>.Ide (\<Lambda>.subst u t)")
           show "\<Lambda>.Ide (\<Lambda>.subst u t)
                   \<Longrightarrow> Std ((\<^bold>\<lambda>\<^bold>[\<Lambda>.Src t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src u) # standard_development (\<Lambda>.subst u t))"
             using 1 \<Lambda>.Arr_Subst \<Lambda>.Ide_Src Ide_iff_standard_development_empty by simp
           assume 2: "\<not> \<Lambda>.Ide (\<Lambda>.subst u t)"
           show "Std ((\<^bold>\<lambda>\<^bold>[\<Lambda>.Src t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src u) # standard_development (\<Lambda>.subst u t))"
           proof -
             have "\<Lambda>.sseq (\<^bold>\<lambda>\<^bold>[\<Lambda>.Src t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src u) (hd (standard_development (\<Lambda>.subst u t)))"
             proof -
               have "\<Lambda>.elementary_reduction (hd (standard_development (\<Lambda>.subst u t)))"
                 using ind
                 by (metis 1 2 \<Lambda>.Arr_Subst Ide_iff_standard_development_empty
                     Std.elims(2) list.sel(1) \<Lambda>.sseq_imp_elementary_reduction1)
               moreover have "\<Lambda>.seq (\<^bold>\<lambda>\<^bold>[\<Lambda>.Src t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src u)
                                    (hd (standard_development (\<Lambda>.subst u t)))"
                 using 1 2 Src_hd_standard_development calculation \<Lambda>.Arr.simps(5)
                        \<Lambda>.Arr_Src \<Lambda>.Arr_Subst \<Lambda>.Src_Subst \<Lambda>.Trg.simps(4) \<Lambda>.Trg_Src \<Lambda>.arr_char
                        \<Lambda>.elementary_reduction_is_arr \<Lambda>.seq_char
                 by presburger
               ultimately show ?thesis
                 using 1 \<Lambda>.Ide_Src \<Lambda>.sseq_Beta by auto
             qed
             moreover have "Std (standard_development (\<Lambda>.subst u t))"
               using 1 ind by blast
             ultimately show ?thesis
               by (metis 1 2 \<Lambda>.Arr_Subst Ide_iff_standard_development_empty Std.simps(3)
                   list.collapse)
           qed
         qed
       qed
     qed
 
     subsection "Standardization"
 
     text \<open>
       In this section, we define and prove correct a function that takes an arbitrary
       reduction path and produces a standard reduction path congruent to it.
       The method is roughly analogous to insertion sort: given a path, recursively
       standardize the tail and then ``insert'' the head into to the result.
       A complication is that in general the head may be a parallel reduction instead
       of an elementary reduction, and in any case elementary reductions are
       not preserved under residuation so we need to be able to handle the parallel
       reductions that arise from permuting elementary reductions.
       In general, this means that parallel reduction steps have to be decomposed into factors,
       and then each factor has to be inserted at its proper position.
       Another issue is that reductions don't all happen at the top level of a term,
       so we need to be able to descend recursively into terms during the insertion
       procedure.  The key idea here is: in a standard reduction, once a step has occurred
       that is not a head reduction, then all subsequent terms will have \<open>App\<close> as their
       top-level constructor.  So, once we have passed a step that is not a head reduction,
       we can recursively descend into the subsequent applications and treat the ``rator''
       and the ``rand'' parts independently.
 
       The following function performs the core insertion part of the standardization
       algorithm.  It assumes that it is given an arbitrary parallel reduction \<open>t\<close> and
       an already-standard reduction path \<open>U\<close>, and it inserts \<open>t\<close> into \<open>U\<close>, producing a
       standard reduction path that is congruent to \<open>t # U\<close>.  A somewhat elaborate case
       analysis is required to determine whether \<open>t\<close> needs to be factored and whether
       part of it might need to be permuted with the head of \<open>U\<close>.  The recursion is complicated
       by the need to make sure that the second argument \<open>U\<close> is always a standard reduction
       path.  This is so that it is possible to decide when the rest of the steps will be
       applications and it is therefore possible to recurse into them.  This constrains what
       recursive calls we can make, since we are not able to make a recursive call in which
       an identity has been prepended to \<open>U\<close>.  Also, if \<open>t # U\<close> consists completely of
       identities, then its standardization is the empty list \<open>[]\<close>, which is not a path
       and cannot be congruent to \<open>t # U\<close>.  So in order to be able to apply the induction
       hypotheses in the correctness proof, we need to make sure that we don't make
       recursive calls when \<open>U\<close> itself would consist entirely of identities.
       Finally, when we descend through an application, the step \<open>t\<close> and the path \<open>U\<close> are
       projected to their ``rator'' and ``rand'' components, which are treated separately
       and the results concatenated.  However, the projection operations can introduce
       identities and therefore do not preserve elementary reductions.  To handle this,
       we need to filter out identities after projection but before the recursive call.
 
       Ensuring termination also involves some care: we make recursive calls in which
       the length of the second argument is increased, but the ``height'' of the first
       argument is decreased.  So we use a lexicographic order that makes the height
       of the first argument more significant and the length of the second argument
       secondary.  The base cases either discard paths that consist entirely of
       identities, or else they expand a single parallel reduction \<open>t\<close> into a standard
       development.
     \<close>
 
     function (sequential) stdz_insert
     where "stdz_insert t [] = standard_development t"
         | "stdz_insert \<^bold>\<guillemotleft>_\<^bold>\<guillemotright> U = stdz_insert (hd U) (tl U)"
         | "stdz_insert \<^bold>\<lambda>\<^bold>[t\<^bold>] U =
            (if \<Lambda>.Ide t then
               stdz_insert (hd U) (tl U)
             else
               map \<Lambda>.Lam (stdz_insert t (map \<Lambda>.un_Lam U)))"
         | "stdz_insert (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<circ> u) ((\<^bold>\<lambda>\<^bold>[_\<^bold>] \<^bold>\<Zspot> _) # U) = stdz_insert (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) U"
         | "stdz_insert (t \<^bold>\<circ> u) U =
            (if \<Lambda>.Ide (t \<^bold>\<circ> u) then
               stdz_insert (hd U) (tl U)
             else if \<Lambda>.seq (t \<^bold>\<circ> u) (hd U) then
               if \<Lambda>.contains_head_reduction (t \<^bold>\<circ> u) then
                 if \<Lambda>.Ide ((t \<^bold>\<circ> u) \\ \<Lambda>.head_redex (t \<^bold>\<circ> u)) then
                   \<Lambda>.head_redex (t \<^bold>\<circ> u) # stdz_insert (hd U) (tl U)
                 else
                   \<Lambda>.head_redex (t \<^bold>\<circ> u) # stdz_insert ((t \<^bold>\<circ> u) \\ \<Lambda>.head_redex (t \<^bold>\<circ> u)) U
               else if \<Lambda>.contains_head_reduction (hd U) then
                 if \<Lambda>.Ide ((t \<^bold>\<circ> u) \\ \<Lambda>.head_strategy (t \<^bold>\<circ> u)) then
                   stdz_insert (\<Lambda>.head_strategy (t \<^bold>\<circ> u)) (tl U)
                 else
                   \<Lambda>.head_strategy (t \<^bold>\<circ> u) # stdz_insert ((t \<^bold>\<circ> u) \\ \<Lambda>.head_strategy (t \<^bold>\<circ> u)) (tl U)
               else
                 map (\<lambda>a. a \<^bold>\<circ> \<Lambda>.Src u)
                     (stdz_insert t (filter notIde (map \<Lambda>.un_App1 U))) @
                 map (\<lambda>b. \<Lambda>.Trg (\<Lambda>.un_App1 (last U)) \<^bold>\<circ> b)
                     (stdz_insert u (filter notIde (map \<Lambda>.un_App2 U)))
             else [])"
         | "stdz_insert (\<^bold>\<lambda>\<^bold>[t\<^bold>] \<^bold>\<Zspot> u) U =
            (if \<Lambda>.Arr t \<and> \<Lambda>.Arr u then
               (\<^bold>\<lambda>\<^bold>[\<Lambda>.Src t\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src u) # stdz_insert (\<Lambda>.subst u t) U
             else [])"
         | "stdz_insert _ _ = []"
     by pat_completeness auto
 
     (*
      * TODO:
      * In the case "stdz_insert (M \<^bold>\<circ> N) U":
      *   The "if \<Lambda>.seq (M \<^bold>\<circ> N) (hd U)" is needed for the termination proof.
      *   The first "if \<Lambda>.Ide (\<Lambda>.resid (M \<^bold>\<circ> N) (\<Lambda>.head_redex (M \<^bold>\<circ> N)))"
      *     cannot be removed because the resulting induction rule does not contain
      *     the induction hypotheses necessary to prove the correctness.
      *   The second "if \<Lambda>.Ide (\<Lambda>.resid (M \<^bold>\<circ> N) (\<Lambda>.head_redex (M \<^bold>\<circ> N)))"
      *     results in a similar, but different problem.
      * In the case "stdz_insert (\<Lambda>.Beta M N) U":
      *   The "if \<Lambda>.Arr M \<and> \<Lambda>.Arr N" is needed for the termination proof.
      * It is possible that the function would still be correct if some of the tests
      *   for whether the term being inserted is an identity were omitted, but if these
      *   tests are removed, then the correctness proof fails ways that are not obviously
      *   repairable, probably due to the induction rule not having all the needed
      *   induction hypotheses.
      *)
 
     fun standardize
     where "standardize [] = []"
         | "standardize U = stdz_insert (hd U) (standardize (tl U))"
 
     abbreviation stdzins_rel
     where "stdzins_rel \<equiv> mlex_prod (length o snd) (inv_image (mlex_prod \<Lambda>.hgt \<Lambda>.subterm_rel) fst)"
 
     termination stdz_insert
       using \<Lambda>.subterm.intros(2-3) \<Lambda>.hgt_Subst less_Suc_eq_le \<Lambda>.elementary_reduction_decreases_hgt
             \<Lambda>.elementary_reduction_head_redex \<Lambda>.contains_head_reduction_iff
             \<Lambda>.elementary_reduction_is_arr \<Lambda>.Src_head_redex \<Lambda>.App_Var_contains_no_head_reduction
             \<Lambda>.hgt_resid_App_head_redex \<Lambda>.seq_char
       apply (relation stdzins_rel)
       apply (auto simp add: wf_mlex \<Lambda>.wf_subterm_rel mlex_iff mlex_less \<Lambda>.subterm_lemmas(1))
       by (meson dual_order.eq_iff length_filter_le not_less_eq_eq)+
 
     lemma stdz_insert_Ide:
-    shows "\<And>t. Ide (t # U) \<Longrightarrow> stdz_insert t U = []"
-    proof (induct U)
+    shows "Ide (t # U) \<Longrightarrow> stdz_insert t U = []"
+    proof (induct U arbitrary: t)
       show "\<And>t. Ide [t] \<Longrightarrow> stdz_insert t [] = []"
         by (metis Ide_iff_standard_development_empty \<Lambda>.Ide_implies_Arr Ide.simps(2)
             \<Lambda>.ide_char stdz_insert.simps(1))
       show "\<And>U. \<lbrakk>\<And>t. Ide (t # U) \<Longrightarrow> stdz_insert t U = []; Ide (t # u # U)\<rbrakk>
                        \<Longrightarrow> stdz_insert t (u # U) = []"
         for t u
         using \<Lambda>.ide_char
         apply (cases t; cases u)
             apply simp_all
         by fastforce
     qed
 
     lemma stdz_insert_Ide_Std:
-    shows "\<And>u. \<lbrakk>\<Lambda>.Ide u; seq [u] U; Std U\<rbrakk> \<Longrightarrow> stdz_insert u U = stdz_insert (hd U) (tl U)"
-    proof (induct U)
+    shows "\<lbrakk>\<Lambda>.Ide u; seq [u] U; Std U\<rbrakk> \<Longrightarrow> stdz_insert u U = stdz_insert (hd U) (tl U)"
+    proof (induct U arbitrary: u)
       show "\<And>u. \<lbrakk>\<Lambda>.Ide u; seq [u] []; Std []\<rbrakk> \<Longrightarrow> stdz_insert u [] = stdz_insert (hd []) (tl [])"
         by (simp add: seq_char)
       fix u v U
       assume u: "\<Lambda>.Ide u"
       assume seq: "seq [u] (v # U)"
       assume Std: "Std (v # U)"
       assume ind: "\<And>u. \<lbrakk>\<Lambda>.Ide u; seq [u] U; Std U\<rbrakk>
                           \<Longrightarrow> stdz_insert u U = stdz_insert (hd U) (tl U)"
       show "stdz_insert u (v # U) = stdz_insert (hd (v # U)) (tl (v # U))"
         using u ind stdz_insert_Ide Ide_implies_Arr
         apply (cases u; cases v)
                             apply simp_all
       proof -
         fix x y a b
         assume xy: "\<Lambda>.Ide x \<and> \<Lambda>.Ide y"
         assume u': "u = x \<^bold>\<circ> y"
         assume v': "v = \<^bold>\<lambda>\<^bold>[a\<^bold>] \<^bold>\<Zspot> b"
         have ab: "\<Lambda>.Ide a \<and> \<Lambda>.Ide b"
           using Std \<open>v = \<^bold>\<lambda>\<^bold>[a\<^bold>] \<^bold>\<Zspot> b\<close> Std.elims(2) \<Lambda>.sseq_Beta
           by (metis Std_consE \<Lambda>.elementary_reduction.simps(5) Std.simps(2))
         have "x = \<^bold>\<lambda>\<^bold>[a\<^bold>] \<and> y = b"
           using xy ab u u' v' seq seq_char
           by (metis \<Lambda>.Ide_iff_Src_self \<Lambda>.Ide_iff_Trg_self \<Lambda>.Ide_implies_Arr \<Lambda>.Src.simps(5)
               Srcs_simp\<^sub>\<Lambda>\<^sub>P Trgs.simps(2) \<Lambda>.lambda.inject(3) list.sel(1) singleton_insert_inj_eq
               \<Lambda>.targets_char\<^sub>\<Lambda>)
         thus "stdz_insert (x \<^bold>\<circ> y) ((\<^bold>\<lambda>\<^bold>[a\<^bold>] \<^bold>\<Zspot> b) # U) = stdz_insert (\<^bold>\<lambda>\<^bold>[a\<^bold>] \<^bold>\<Zspot> b) U"
           using u u' stdz_insert.simps(4) by presburger
       qed
     qed
 
     text \<open>
       Insertion of a term with \<open>Beta\<close> as its top-level constructor always
       leaves such a term at the head of the result.  Stated another way,
       \<open>Beta\<close> at the top-level must always come first in a standard reduction path.
     \<close>
 
     lemma stdz_insert_Beta_ind:
-    shows "\<And>t U. \<lbrakk>\<Lambda>.hgt t + length U \<le> n; \<Lambda>.is_Beta t; seq [t] U\<rbrakk>
-                    \<Longrightarrow> \<Lambda>.is_Beta (hd (stdz_insert t U))"
-    proof (induct n)
+    shows "\<lbrakk>\<Lambda>.hgt t + length U \<le> n; \<Lambda>.is_Beta t; seq [t] U\<rbrakk>
+              \<Longrightarrow> \<Lambda>.is_Beta (hd (stdz_insert t U))"
+    proof (induct n arbitrary: t U)
       show "\<And>t U. \<lbrakk>\<Lambda>.hgt t + length U \<le> 0; \<Lambda>.is_Beta t; seq [t] U\<rbrakk>
                       \<Longrightarrow> \<Lambda>.is_Beta (hd (stdz_insert t U))"
         using Arr.simps(1) seq_char by blast
       fix n t U
       assume ind: "\<And>t U. \<lbrakk>\<Lambda>.hgt t + length U \<le> n; \<Lambda>.is_Beta t; seq [t] U\<rbrakk>
                              \<Longrightarrow> \<Lambda>.is_Beta (hd (stdz_insert t U))"
       assume seq: "seq [t] U"
       assume n: "\<Lambda>.hgt t + length U \<le> Suc n"
       assume t: "\<Lambda>.is_Beta t"
       show "\<Lambda>.is_Beta (hd (stdz_insert t U))"
         using t seq seq_char
         by (cases U; cases t; cases "hd U") auto
     qed
 
     lemma stdz_insert_Beta:
     assumes "\<Lambda>.is_Beta t" and "seq [t] U"
     shows "\<Lambda>.is_Beta (hd (stdz_insert t U))"
       using assms stdz_insert_Beta_ind by blast
 
     text \<open>
       This is the correctness lemma for insertion:
       Given a term \<open>t\<close> and standard reduction path \<open>U\<close> sequential with it,
       the result of insertion is a standard reduction path which is
       congruent to \<open>t # U\<close> unless \<open>t # U\<close> consists entirely of identities.
 
       The proof is very long.  Its structure parallels that of the definition
       of the function \<open>stdz_insert\<close>.  For really understanding the details,
       I strongly suggest viewing the proof in Isabelle/JEdit and using the
       code folding feature to unfold the proof a little bit at a time.
     \<close>
 
     lemma stdz_insert_correctness:
     shows "seq [t] U \<and> Std U \<longrightarrow>
               Std (stdz_insert t U) \<and> (\<not> Ide (t # U) \<longrightarrow> cong (stdz_insert t U) (t # U))"
            (is "?P t U")
     proof (rule stdz_insert.induct [of ?P])
       show "\<And>t. ?P t []"
         using seq_char by simp
       show "\<And>u U. ?P \<^bold>\<sharp> (u # U)"
         using seq_char not_arr_null null_char by auto
       show "\<And>x u U. ?P (hd (u # U)) (tl (u # U)) \<Longrightarrow> ?P \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> (u # U)"
       proof -
         fix x u U
         assume ind: "?P (hd (u # U)) (tl (u # U))"
         show "?P \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> (u # U)"
         proof (intro impI, elim conjE, intro conjI)
           assume seq: "seq [\<^bold>\<guillemotleft>x\<^bold>\<guillemotright>] (u # U)"
           assume Std: "Std (u # U)"
           have 1: "stdz_insert \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> (u # U) = stdz_insert u U"
             by simp
           have 2: "U \<noteq> [] \<Longrightarrow> seq [u] U"
             using Std Std_imp_Arr
             by (simp add: arrI\<^sub>P arr_append_imp_seq)
           show "Std (stdz_insert \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> (u # U))"
             using ind
             by (metis 1 2 Std Std_standard_development list.exhaust_sel list.sel(1) list.sel(3)
                 reduction_paths.Std.simps(3) reduction_paths.stdz_insert.simps(1))
           show "\<not> Ide (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> # u # U) \<longrightarrow> stdz_insert \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> (u # U) \<^sup>*\<sim>\<^sup>* \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> # u # U"
           proof (cases "U = []")
             show "U = [] \<Longrightarrow> ?thesis"
               using cong_standard_development cong_cons_ideI(1)
               apply simp
               by (metis Arr.simps(1-2) Arr_iff_Con_self Con_rec(3) \<Lambda>.in_sourcesI con_char
                   cong_transitive ideE \<Lambda>.Ide.simps(2) \<Lambda>.arr_char \<Lambda>.ide_char seq)
             assume U: "U \<noteq> []"
             show ?thesis
               using 1 2 ind seq seq_char cong_cons_ideI(1)
               apply simp
               by (metis Std Std_consE U \<Lambda>.Arr.simps(2) \<Lambda>.Ide.simps(2) \<Lambda>.targets_simps(2)
                   prfx_transitive)
           qed
         qed
       qed
       show "\<And>M u U. \<lbrakk>\<Lambda>.Ide M \<Longrightarrow> ?P (hd (u # U)) (tl (u # U));
                      \<not> \<Lambda>.Ide M \<Longrightarrow> ?P M (map \<Lambda>.un_Lam (u # U))\<rbrakk>
                          \<Longrightarrow> ?P \<^bold>\<lambda>\<^bold>[M\<^bold>] (u # U)"
       proof -
         fix M u U
         assume ind1: "\<Lambda>.Ide M \<Longrightarrow> ?P (hd (u # U)) (tl (u # U))"
         assume ind2: "\<not> \<Lambda>.Ide M \<Longrightarrow> ?P M (map \<Lambda>.un_Lam (u # U))"
         show "?P \<^bold>\<lambda>\<^bold>[M\<^bold>] (u # U)"
         proof (intro impI, elim conjE)
           assume seq: "seq [\<^bold>\<lambda>\<^bold>[M\<^bold>]] (u # U)"
           assume Std: "Std (u # U)"
           have u: "\<Lambda>.is_Lam u"
             using seq
             by (metis insert_subset \<Lambda>.lambda.disc(8) list.simps(15) mem_Collect_eq
                 seq_Lam_Arr_implies)
           have U: "set U \<subseteq> Collect \<Lambda>.is_Lam"
             using u seq
             by (metis insert_subset \<Lambda>.lambda.disc(8) list.simps(15) seq_Lam_Arr_implies)
           show "Std (stdz_insert \<^bold>\<lambda>\<^bold>[M\<^bold>] (u # U)) \<and>
                   (\<not> Ide (\<^bold>\<lambda>\<^bold>[M\<^bold>] # u # U) \<longrightarrow> stdz_insert \<^bold>\<lambda>\<^bold>[M\<^bold>] (u # U) \<^sup>*\<sim>\<^sup>* \<^bold>\<lambda>\<^bold>[M\<^bold>] # u # U)"
           proof (cases "\<Lambda>.Ide M")
             assume M: "\<Lambda>.Ide M"
             have 1: "stdz_insert \<^bold>\<lambda>\<^bold>[M\<^bold>] (u # U) = stdz_insert u U"
               using M by simp
             show ?thesis
             proof (cases "Ide (u # U)")
               show "Ide (u # U) \<Longrightarrow> ?thesis"
                 using 1 Std_standard_development Ide_iff_standard_development_empty
                 by (metis Ide_imp_Ide_hd Std Std_implies_set_subset_elementary_reduction
                     \<Lambda>.elementary_reduction_not_ide list.sel(1) list.set_intros(1)
                     mem_Collect_eq subset_code(1))
               assume 2: "\<not> Ide (u # U)"
               show ?thesis
               proof (cases "U = []")
                 assume 3: "U = []"
                 have 4: "standard_development u \<^sup>*\<sim>\<^sup>* [\<^bold>\<lambda>\<^bold>[M\<^bold>]] @ [u]"
                   using M 2 3 seq ide_char cong_standard_development [of u]
                         cong_append_ideI(1) [of "[\<^bold>\<lambda>\<^bold>[M\<^bold>]]" "[u]"]
                   by (metis Arr_imp_arr_hd Ide.simps(2) Std Std_imp_Arr cong_transitive
                       \<Lambda>.Ide.simps(3) \<Lambda>.arr_char \<Lambda>.ide_char list.sel(1) not_Cons_self2)
                 show ?thesis
                   using 1 3 4 Std_standard_development by force
                 next
                 assume 3: "U \<noteq> []"
                 have "stdz_insert \<^bold>\<lambda>\<^bold>[M\<^bold>] (u # U) = stdz_insert u U"
                   using M 3 by simp
                 have 5: "\<Lambda>.Arr u \<and> \<not> \<Lambda>.Ide u"
                   by (meson "3" Std Std_consE \<Lambda>.elementary_reduction_not_ide \<Lambda>.ide_char
                       \<Lambda>.sseq_imp_elementary_reduction1)
                 have 4: "standard_development u @ U \<^sup>*\<sim>\<^sup>* ([\<^bold>\<lambda>\<^bold>[M\<^bold>]] @ [u]) @ U"
                 proof (intro cong_append seqI\<^sub>\<Lambda>\<^sub>P)
                   show "Arr (standard_development u)"
                     using 5 Std_standard_development Std_imp_Arr Ide_iff_standard_development_empty
                     by force
                   show "Arr U"
                     using Std 3 by auto
                   show "\<Lambda>.Trg (last (standard_development u)) = \<Lambda>.Src (hd U)"
                     by (metis "3" "5" Std Std_consE Trg_last_standard_development \<Lambda>.seq_char
                         \<Lambda>.sseq_imp_seq)
                   show "standard_development u \<^sup>*\<sim>\<^sup>* [\<^bold>\<lambda>\<^bold>[M\<^bold>]] @ [u]"
                     using M 5 Std Std_imp_Arr cong_standard_development [of u]
                           cong_append_ideI(3) [of "[\<^bold>\<lambda>\<^bold>[M\<^bold>]]" "[u]"]
                     by (metis (no_types, lifting) Arr.simps(2) Ide.simps(2) arr_char ide_char
                         \<Lambda>.Ide.simps(3) \<Lambda>.arr_char \<Lambda>.ide_char prfx_transitive seq seq_def
                         sources_cons)
                   show "U \<^sup>*\<sim>\<^sup>* U"
                     by (simp add: \<open>Arr U\<close> arr_char prfx_reflexive)
                 qed
                 show ?thesis
                 proof (intro conjI)
                   show "Std (stdz_insert \<^bold>\<lambda>\<^bold>[M\<^bold>] (u # U))"
                     by (metis (no_types, lifting) 1 3 M Std Std_consE append_Cons
                         append_eq_append_conv2 append_self_conv arr_append_imp_seq ind1
                         list.sel(1) list.sel(3) not_Cons_self2 seq seq_def)
                   show "\<not> Ide (\<^bold>\<lambda>\<^bold>[M\<^bold>] # u # U) \<longrightarrow> stdz_insert \<^bold>\<lambda>\<^bold>[M\<^bold>] (u # U) \<^sup>*\<sim>\<^sup>* \<^bold>\<lambda>\<^bold>[M\<^bold>] # u # U"
                   proof
                     have "seq [u] U \<and> Std U"
                       using 2 3 Std
                       by (metis Cons_eq_appendI Std_consE arr_append_imp_seq neq_Nil_conv
                           self_append_conv2 seq seqE)
                     thus "stdz_insert \<^bold>\<lambda>\<^bold>[M\<^bold>] (u # U) \<^sup>*\<sim>\<^sup>* \<^bold>\<lambda>\<^bold>[M\<^bold>] # u # U"
                       using M 1 2 3 4 ind1 cong_cons_ideI(1) [of "\<^bold>\<lambda>\<^bold>[M\<^bold>]" "u # U"]
                       apply simp
                       by (meson cong_transitive seq)
                   qed
                 qed
               qed
             qed
             next
             assume M: "\<not> \<Lambda>.Ide M"
             have 1: "stdz_insert \<^bold>\<lambda>\<^bold>[M\<^bold>] (u # U) =
                      map \<Lambda>.Lam (stdz_insert M (\<Lambda>.un_Lam u # map \<Lambda>.un_Lam U))"
               using M by simp
             show ?thesis
             proof (intro conjI)
               show "Std (stdz_insert \<^bold>\<lambda>\<^bold>[M\<^bold>] (u # U))"
                 by (metis "1" M Std Std_map_Lam Std_map_un_Lam ind2 \<Lambda>.lambda.disc(8)
                     list.simps(9) seq seq_Lam_Arr_implies seq_map_un_Lam)
               show "\<not> Ide (\<^bold>\<lambda>\<^bold>[M\<^bold>] # u # U) \<longrightarrow> stdz_insert \<^bold>\<lambda>\<^bold>[M\<^bold>] (u # U) \<^sup>*\<sim>\<^sup>* \<^bold>\<lambda>\<^bold>[M\<^bold>] # u # U"
               proof
                 have "map \<Lambda>.Lam (stdz_insert M (\<Lambda>.un_Lam u # map \<Lambda>.un_Lam U)) \<^sup>*\<sim>\<^sup>*
                       \<^bold>\<lambda>\<^bold>[M\<^bold>] # u # U"
                 proof - 
                   have "map \<Lambda>.Lam (stdz_insert M (\<Lambda>.un_Lam u # map \<Lambda>.un_Lam U)) \<^sup>*\<sim>\<^sup>*
                         map \<Lambda>.Lam (M # \<Lambda>.un_Lam u # map \<Lambda>.un_Lam U)"
                     by (metis (mono_tags, opaque_lifting) Ide_imp_Ide_hd M Std Std_map_un_Lam
                         cong_map_Lam ind2 \<Lambda>.ide_char \<Lambda>.lambda.discI(2)
                         list.sel(1) list.simps(9) seq seq_Lam_Arr_implies seq_map_un_Lam)
                   thus ?thesis
                     using u U
                     by (simp add: map_idI subset_code(1))
                 qed
                 thus "stdz_insert \<^bold>\<lambda>\<^bold>[M\<^bold>] (u # U) \<^sup>*\<sim>\<^sup>* \<^bold>\<lambda>\<^bold>[M\<^bold>] # u # U"
                   using "1" by presburger
               qed
             qed
           qed
         qed
       qed
       show "\<And>M N A B U. ?P (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) U \<Longrightarrow> ?P (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<circ> N) ((\<^bold>\<lambda>\<^bold>[A\<^bold>] \<^bold>\<Zspot> B) # U)"
       proof -
         fix M N A B U
         assume ind: "?P (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) U"
         show "?P (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<circ> N) ((\<^bold>\<lambda>\<^bold>[A\<^bold>] \<^bold>\<Zspot> B) # U)"
         proof (intro impI, elim conjE)
           assume seq: "seq [\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<circ> N] ((\<^bold>\<lambda>\<^bold>[A\<^bold>] \<^bold>\<Zspot> B) # U)"
           assume Std: "Std ((\<^bold>\<lambda>\<^bold>[A\<^bold>] \<^bold>\<Zspot> B) # U)"
           have MN: "\<Lambda>.Arr M \<and> \<Lambda>.Arr N"
             using seq
             by (simp add: seq_char)
           have AB: "\<Lambda>.Trg M = A \<and> \<Lambda>.Trg N = B"
           proof -
             have 1: "\<Lambda>.Ide A \<and> \<Lambda>.Ide B"
               using Std
               by (metis Std.simps(2) Std.simps(3) \<Lambda>.elementary_reduction.simps(5)
                         list.exhaust_sel \<Lambda>.sseq_Beta)
             moreover have "Trgs [\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<circ> N] = Srcs [\<^bold>\<lambda>\<^bold>[A\<^bold>] \<^bold>\<Zspot> B]"
               using 1 seq seq_char
               by (simp add: \<Lambda>.Ide_implies_Arr Srcs_simp\<^sub>\<Lambda>\<^sub>P)
             ultimately show ?thesis
               by (metis \<Lambda>.Ide_iff_Src_self \<Lambda>.Ide_implies_Arr \<Lambda>.Src.simps(5) Srcs_simp\<^sub>\<Lambda>\<^sub>P
                   \<Lambda>.Trg.simps(2-3) Trgs_simp\<^sub>\<Lambda>\<^sub>P \<Lambda>.lambda.inject(2) \<Lambda>.lambda.sel(3-4)
                   last.simps list.sel(1) seq_char seq the_elem_eq)
           qed
           have 1: "stdz_insert (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<circ> N) ((\<^bold>\<lambda>\<^bold>[A\<^bold>] \<^bold>\<Zspot> B) # U) = stdz_insert (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) U"
             by auto
           show "Std (stdz_insert (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<circ> N) ((\<^bold>\<lambda>\<^bold>[A\<^bold>] \<^bold>\<Zspot> B) # U)) \<and>
                 (\<not> Ide ((\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<circ> N) # (\<^bold>\<lambda>\<^bold>[A\<^bold>] \<^bold>\<Zspot> B) # U) \<longrightarrow>
                    stdz_insert (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<circ> N) ((\<^bold>\<lambda>\<^bold>[A\<^bold>] \<^bold>\<Zspot> B) # U) \<^sup>*\<sim>\<^sup>* (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<circ> N) # (\<^bold>\<lambda>\<^bold>[A\<^bold>] \<^bold>\<Zspot> B) # U)"
           proof (cases "U = []")
             assume U: "U = []"
             have 1: "stdz_insert (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<circ> N) ((\<^bold>\<lambda>\<^bold>[A\<^bold>] \<^bold>\<Zspot> B) # U) =
                      standard_development (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N)"
               using U by simp
             show ?thesis
             proof (intro conjI)
               show "Std (stdz_insert (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<circ> N) ((\<^bold>\<lambda>\<^bold>[A\<^bold>] \<^bold>\<Zspot> B) # U))"
                 using 1 Std_standard_development by presburger
               show "\<not> Ide ((\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<circ> N) # (\<^bold>\<lambda>\<^bold>[A\<^bold>] \<^bold>\<Zspot> B) # U) \<longrightarrow>
                       stdz_insert (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<circ> N) ((\<^bold>\<lambda>\<^bold>[A\<^bold>] \<^bold>\<Zspot> B) # U) \<^sup>*\<sim>\<^sup>* (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<circ> N) # (\<^bold>\<lambda>\<^bold>[A\<^bold>] \<^bold>\<Zspot> B) # U"
               proof (intro impI)
                 assume 2: "\<not> Ide ((\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<circ> N) # (\<^bold>\<lambda>\<^bold>[A\<^bold>] \<^bold>\<Zspot> B) # U)"
                 have "stdz_insert (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<circ> N) ((\<^bold>\<lambda>\<^bold>[A\<^bold>] \<^bold>\<Zspot> B) # U) =
                       (\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N) # standard_development (\<Lambda>.subst N M)"
                   using 1 MN by simp
                 also have "... \<^sup>*\<sim>\<^sup>* [\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N]"
                   using MN AB cong_standard_development
                   by (metis 1 calculation \<Lambda>.Arr.simps(5) \<Lambda>.Ide.simps(5))
                 also have "[\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N] \<^sup>*\<sim>\<^sup>* (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<circ> N) # (\<^bold>\<lambda>\<^bold>[A\<^bold>] \<^bold>\<Zspot> B) # U"
                   using AB MN U Beta_decomp(2) [of M N] by simp
                 finally show "stdz_insert (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<circ> N) ((\<^bold>\<lambda>\<^bold>[A\<^bold>] \<^bold>\<Zspot> B) # U) \<^sup>*\<sim>\<^sup>*
                               (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<circ> N) # (\<^bold>\<lambda>\<^bold>[A\<^bold>] \<^bold>\<Zspot> B) # U"
                   by blast
               qed
             qed
             next
             assume U: "U \<noteq> []"
             have 1: "stdz_insert (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<circ> N) ((\<^bold>\<lambda>\<^bold>[A\<^bold>] \<^bold>\<Zspot> B) # U) = stdz_insert (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) U"
               using U by simp
             have 2: "seq [\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N] U"
               using MN AB U Std \<Lambda>.sseq_imp_seq
               apply (intro seqI\<^sub>\<Lambda>\<^sub>P)
                 apply auto
               by fastforce
             have 3: "Std U"
               using Std by fastforce
             show ?thesis
             proof (intro conjI)
               show "Std (stdz_insert (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<circ> N) ((\<^bold>\<lambda>\<^bold>[A\<^bold>] \<^bold>\<Zspot> B) # U))"
                 using 2 3 ind by simp
               show "\<not> Ide ((\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<circ> N) # (\<^bold>\<lambda>\<^bold>[A\<^bold>] \<^bold>\<Zspot> B) # U) \<longrightarrow>
                       stdz_insert (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<circ> N) ((\<^bold>\<lambda>\<^bold>[A\<^bold>] \<^bold>\<Zspot> B) # U) \<^sup>*\<sim>\<^sup>* (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<circ> N) # (\<^bold>\<lambda>\<^bold>[A\<^bold>] \<^bold>\<Zspot> B) # U"
               proof
                 have "stdz_insert (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<circ> N) ((\<^bold>\<lambda>\<^bold>[A\<^bold>] \<^bold>\<Zspot> B) # U) \<^sup>*\<sim>\<^sup>* [\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N] @ U"
                   by (metis "1" "2" "3" \<Lambda>.Ide.simps(5) U Ide.simps(3) append.left_neutral
                       append_Cons \<Lambda>.ide_char ind list.exhaust)
                 also have "[\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N] @ U \<^sup>*\<sim>\<^sup>* ([\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<circ> N] @ [\<^bold>\<lambda>\<^bold>[A\<^bold>] \<^bold>\<Zspot> B]) @ U"
                   using MN AB Beta_decomp
                   by (meson "2" cong_append cong_reflexive seqE)
                 also have "([\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<circ> N] @ [\<^bold>\<lambda>\<^bold>[A\<^bold>] \<^bold>\<Zspot> B]) @ U = (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<circ> N) # (\<^bold>\<lambda>\<^bold>[A\<^bold>] \<^bold>\<Zspot> B) # U"
                   by simp
                 finally show "stdz_insert (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<circ> N) ((\<^bold>\<lambda>\<^bold>[A\<^bold>] \<^bold>\<Zspot> B) # U) \<^sup>*\<sim>\<^sup>*
                               (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<circ> N) # (\<^bold>\<lambda>\<^bold>[A\<^bold>] \<^bold>\<Zspot> B) # U"
                   by argo
               qed
             qed
           qed
         qed
       qed
       show "\<And>M N u U. (\<Lambda>.Arr M \<and> \<Lambda>.Arr N \<Longrightarrow> ?P (\<Lambda>.subst N M) (u # U))
                           \<Longrightarrow> ?P (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) (u # U)"
       proof -
         fix M N u U
         assume ind: "\<Lambda>.Arr M \<and> \<Lambda>.Arr N \<Longrightarrow> ?P (\<Lambda>.subst N M) (u # U)"
         show "?P (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) (u # U)"
         proof (intro impI, elim conjE)
           assume seq: "seq [\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N] (u # U)"
           assume Std: "Std (u # U)"
           have MN: "\<Lambda>.Arr M \<and> \<Lambda>.Arr N"
             using seq seq_char by simp
           show "Std (stdz_insert (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) (u # U)) \<and>
                 (\<not> Ide (\<Lambda>.Beta M N # u # U) \<longrightarrow>
                     cong (stdz_insert (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) (u # U)) ((\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) # u # U))"
           proof (cases "\<Lambda>.Ide (\<Lambda>.subst N M)")
             assume 1: "\<Lambda>.Ide (\<Lambda>.subst N M)"
             have 2: "\<not> Ide (u # U)"
               using Std Std_implies_set_subset_elementary_reduction \<Lambda>.elementary_reduction_not_ide
               by force
             have 3: "stdz_insert (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) (u # U) = (\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N) # stdz_insert u U"
               using MN 1 seq seq_char Std stdz_insert_Ide_Std [of "\<Lambda>.subst N M" "u # U"]
                      \<Lambda>.Ide_implies_Arr
               by (cases "U = []") auto
             show ?thesis
             proof (cases "U = []")
               assume U: "U = []"
               have 3: "stdz_insert (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) (u # U) =
                        (\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N) # standard_development u"
                 using 2 3 U by force
               have 4: "\<Lambda>.seq (\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N) (hd (standard_development u))"
               proof
                 show "\<Lambda>.Arr (\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N)"
                   using MN by simp
                 show "\<Lambda>.Arr (hd (standard_development u))"
                   by (metis 2 Arr_imp_arr_hd Ide.simps(2) Ide_iff_standard_development_empty
                       Std Std_consE Std_imp_Arr Std_standard_development U \<Lambda>.arr_char
                       \<Lambda>.ide_char)
                 show "\<Lambda>.Trg (\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N) = \<Lambda>.Src (hd (standard_development u))"
                   by (metis 1 2 Ide.simps(2) MN Src_hd_standard_development Std Std_consE
                       Trg_last_Src_hd_eqI U \<Lambda>.Ide_iff_Src_self \<Lambda>.Ide_implies_Arr \<Lambda>.Src_Subst
                       \<Lambda>.Trg.simps(4) \<Lambda>.Trg_Src \<Lambda>.Trg_Subst \<Lambda>.ide_char last_ConsL list.sel(1) seq)
               qed
               show ?thesis
               proof (intro conjI)
                 show "Std (stdz_insert (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) (u # U))"
                 proof -
                   have "\<Lambda>.sseq (\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N) (hd (standard_development u))"
                     using MN 2 4 U \<Lambda>.Ide_Src
                     apply (intro \<Lambda>.sseq_BetaI)
                        apply auto
                     by (metis Ide.simps(1) Resid.simps(2) Std Std_consE
                         Std_standard_development cong_standard_development hd_Cons_tl ide_char
                         \<Lambda>.sseq_imp_elementary_reduction1 Std.simps(2))
                   thus ?thesis
                     by (metis 3 Std.simps(2-3) Std_standard_development hd_Cons_tl
                         \<Lambda>.sseq_imp_elementary_reduction1)
                 qed
                 show "\<not> Ide ((\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) # u # U)
                           \<longrightarrow> stdz_insert (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) (u # U) \<^sup>*\<sim>\<^sup>* (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) # u # U"
                 proof
                   have "stdz_insert (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) (u # U) =
                         [\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N] @ standard_development u"
                     using 3 by simp
                   also have 5: "[\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N] @ standard_development u \<^sup>*\<sim>\<^sup>*
                                 [\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N] @ [u]"
                   proof (intro cong_append)
                     show "seq [\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N] (standard_development u)"
                       by (metis 2 3 Ide.simps(2) Ide_iff_standard_development_empty
                           Std Std_consE Std_imp_Arr U \<open>Std (stdz_insert (\<Lambda>.Beta M N) (u # U))\<close>
                           arr_append_imp_seq arr_char calculation \<Lambda>.ide_char neq_Nil_conv)
                     thus "[\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N] \<^sup>*\<sim>\<^sup>* [\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N]"
                       using cong_reflexive by blast
                     show "standard_development u \<^sup>*\<sim>\<^sup>* [u]"
                       by (metis 2 Arr.simps(2) Ide.simps(2) Std Std_imp_Arr U
                           cong_standard_development \<Lambda>.arr_char \<Lambda>.ide_char not_Cons_self2)
                   qed
                   also have "[\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N] @ [u] \<^sup>*\<sim>\<^sup>*
                              ([\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N] @ [\<Lambda>.subst N M]) @ [u]"
                   proof (intro cong_append)
                     show "seq [\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N] [u]"
                       by (metis 5 Con_implies_Arr(1) Ide.simps(1) arr_append_imp_seq
                           arr_char ide_char not_Cons_self2)
                     show "[\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N] \<^sup>*\<sim>\<^sup>* [\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N] @ [\<Lambda>.subst N M]"
                       by (metis (full_types) 1 MN Ide_iff_standard_development_empty
                           cong_standard_development cong_transitive \<Lambda>.Arr.simps(5) \<Lambda>.Arr_Subst
                           \<Lambda>.Ide.simps(5) Beta_decomp(1) standard_development.simps(5))
                     show "[u] \<^sup>*\<sim>\<^sup>* [u]"
                       using Resid_Arr_self Std Std_imp_Arr U ide_char by blast
                   qed
                   also have "([\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N] @ [\<Lambda>.subst N M]) @ [u] \<^sup>*\<sim>\<^sup>* [\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N] @ [u]"
                     by (metis Beta_decomp(1) MN U Resid_Arr_self cong_append
                         ide_char seq_char seq)
                   also have "[\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N] @ [u] = (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) # u # U"
                     using U by simp
                   finally show "stdz_insert (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) (u # U) \<^sup>*\<sim>\<^sup>* (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) # u # U"
                     by blast
                 qed
               qed
               next
               assume U: "U \<noteq> []"
               have 4: "seq [u] U"
                 by (simp add: Std U arrI\<^sub>P arr_append_imp_seq)
               have 5: "Std U"
                 using Std by auto
               have 6: "Std (stdz_insert u U) \<and>
                        set (stdz_insert u U) \<subseteq> {a. \<Lambda>.elementary_reduction a} \<and>
                        (\<not> Ide (u # U) \<longrightarrow>
                        cong (stdz_insert u U) (u # U))"
               proof -
                 have "seq [\<Lambda>.subst N M] (u # U) \<and> Std (u # U)"
                   using MN Std Std_imp_Arr \<Lambda>.Arr_Subst
                   apply (intro conjI seqI\<^sub>\<Lambda>\<^sub>P)
                      apply simp_all
                   by (metis Trg_last_Src_hd_eqI \<Lambda>.Trg.simps(4) last_ConsL list.sel(1) seq)
                 thus ?thesis
                   using MN 1 2 3 4 5 ind Std_implies_set_subset_elementary_reduction
                         stdz_insert_Ide_Std
                   apply simp
                   by (meson cong_cons_ideI(1) cong_transitive lambda_calculus.ide_char)
               qed
               have 7: "\<Lambda>.seq (\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N) (hd (stdz_insert u U))"
                 using MN 1 2 6 Arr_imp_arr_hd Con_implies_Arr(2) ide_char \<Lambda>.arr_char
                       Ide_iff_standard_development_empty Src_hd_eqI Trg_last_Src_hd_eqI
                       Trg_last_standard_development \<Lambda>.Ide_implies_Arr seq
                 apply (intro \<Lambda>.seqI\<^sub>\<Lambda>)
                   apply simp
                  apply (metis Ide.simps(1))
                 by (metis \<Lambda>.Arr.simps(5) \<Lambda>.Ide.simps(5) last.simps standard_development.simps(5))
               have 8: "seq [\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N] (stdz_insert u U)"
                 by (metis 2 6 7 seqI\<^sub>\<Lambda>\<^sub>P Arr.simps(2) Con_implies_Arr(2)
                     Ide.simps(1) ide_char last.simps \<Lambda>.seqE \<Lambda>.seq_char)
               show ?thesis
               proof (intro conjI)
                 show "Std (stdz_insert (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) (u # U))"
                 proof -
                   have "\<Lambda>.sseq (\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N) (hd (stdz_insert u U))"
                     by (metis MN 2 6 7 \<Lambda>.Ide_Src Std.elims(2) Ide.simps(1)
                         Resid.simps(2) ide_char list.sel(1) \<Lambda>.sseq_BetaI
                         \<Lambda>.sseq_imp_elementary_reduction1)
                   thus ?thesis
                     by (metis 2 3 6 Std.simps(3) Resid.simps(1) con_char prfx_implies_con
                         list.exhaust_sel)
                 qed
                 show "\<not> Ide ((\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) # u # U)
                           \<longrightarrow> stdz_insert (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) (u # U) \<^sup>*\<sim>\<^sup>* (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) # u # U"
                 proof
                   have "stdz_insert (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) (u # U) = [\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N] @ stdz_insert u U"
                     using 3 by simp
                   also have "... \<^sup>*\<sim>\<^sup>* [\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N] @ u # U"
                     using MN 2 3 6 8 cong_append
                     by (meson cong_reflexive seqE)
                   also have "[\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N] @ u # U \<^sup>*\<sim>\<^sup>*
                              ([\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N] @ [\<Lambda>.subst N M]) @ u # U"
                     using MN 1 2 6 8 Beta_decomp(1) Std Src_hd_eqI Trg_last_Src_hd_eqI
                           \<Lambda>.Arr_Subst \<Lambda>.ide_char ide_char
                     apply (intro cong_append cong_append_ideI seqI\<^sub>\<Lambda>\<^sub>P)
                            apply auto[2]
                          apply metis
                         apply auto[4]
                     by (metis cong_transitive)
                   also have "([\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N] @ [\<Lambda>.subst N M]) @ u # U \<^sup>*\<sim>\<^sup>*
                              [\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N] @ u # U"
                     by (meson MN 2 6 Beta_decomp(1) cong_append prfx_transitive seq)
                   also have "[\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N] @ u # U = (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) # u # U"
                     by simp
                   finally show "stdz_insert (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) (u # U) \<^sup>*\<sim>\<^sup>* (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) # u # U"
                     by simp
                 qed
               qed
             qed
             next
             assume 1: "\<not> \<Lambda>.Ide (\<Lambda>.subst N M)"
             have 2: "stdz_insert (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) (u # U) =
                      (\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N) # stdz_insert (\<Lambda>.subst N M) (u # U)"
               using 1 MN by simp
             have 3: "seq [\<Lambda>.subst N M] (u # U)"
               using \<Lambda>.Arr_Subst MN seq_char seq by force
             have 4: "Std (stdz_insert (\<Lambda>.subst N M) (u # U)) \<and>
                      set (stdz_insert (\<Lambda>.subst N M) (u # U)) \<subseteq> {a. \<Lambda>.elementary_reduction a} \<and>
                      stdz_insert (\<Lambda>.Subst 0 N M) (u # U) \<^sup>*\<sim>\<^sup>* \<Lambda>.subst N M # u # U"
               using 1 3 Std ind MN Ide.simps(3) \<Lambda>.ide_char
                     Std_implies_set_subset_elementary_reduction
               by presburger
             have 5: "\<Lambda>.seq (\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N) (hd (stdz_insert (\<Lambda>.subst N M) (u # U)))"
               using MN 4
               apply (intro \<Lambda>.seqI\<^sub>\<Lambda>)
                 apply simp
                apply (metis Arr_imp_arr_hd Con_implies_Arr(1) Ide.simps(1) ide_char \<Lambda>.arr_char)
               using Src_hd_eqI
               by force
             show ?thesis
             proof (intro conjI)
               show "Std (stdz_insert (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) (u # U))"
               proof -
                 have "\<Lambda>.sseq (\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N) (hd (stdz_insert (\<Lambda>.subst N M) (u # U)))"
                   using 5
                   by (metis 4 MN \<Lambda>.Ide_Src Std.elims(2) Ide.simps(1) Resid.simps(2)
                       ide_char list.sel(1) \<Lambda>.sseq_BetaI \<Lambda>.sseq_imp_elementary_reduction1)
                 thus ?thesis
                   by (metis 2 4 Std.simps(3) Arr.simps(1) Con_implies_Arr(2)
                       Ide.simps(1) ide_char list.exhaust_sel)
               qed
               show "\<not> Ide ((\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) # u # U)
                         \<longrightarrow> stdz_insert (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) (u # U) \<^sup>*\<sim>\<^sup>* (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) # u # U"
               proof
                 have "stdz_insert (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) (u # U) =
                       [\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N] @ stdz_insert (\<Lambda>.subst N M) (u # U)"
                   using 2 by simp
                 also have "... \<^sup>*\<sim>\<^sup>* [\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N] @ \<Lambda>.subst N M # u # U"
                 proof (intro cong_append)
                   show "seq [\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N] (stdz_insert (\<Lambda>.subst N M) (u # U))"
                     by (metis 4 5 Arr.simps(2) Con_implies_Arr(1) Ide.simps(1) ide_char
                         \<Lambda>.arr_char \<Lambda>.seq_char last_ConsL seqI\<^sub>\<Lambda>\<^sub>P)
                   show "[\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N] \<^sup>*\<sim>\<^sup>* [\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N]"
                     by (meson MN cong_transitive \<Lambda>.Arr_Src Beta_decomp(1))
                   show "stdz_insert (\<Lambda>.subst N M) (u # U) \<^sup>*\<sim>\<^sup>* \<Lambda>.subst N M # u # U"
                     using 4 by fastforce
                 qed
                 also have "[\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N] @ \<Lambda>.subst N M # u # U =
                            ([\<^bold>\<lambda>\<^bold>[\<Lambda>.Src M\<^bold>] \<^bold>\<Zspot> \<Lambda>.Src N] @ [\<Lambda>.subst N M]) @ u # U"
                   by simp
                 also have "... \<^sup>*\<sim>\<^sup>* [\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N] @ u # U"
                   by (meson Beta_decomp(1) MN cong_append cong_reflexive seqE seq)
                 also have "[\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N] @ u # U = (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) # u # U"
                   by simp
                 finally show "stdz_insert (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) (u # U) \<^sup>*\<sim>\<^sup>* (\<^bold>\<lambda>\<^bold>[M\<^bold>] \<^bold>\<Zspot> N) # u # U"
                   by blast
               qed
             qed
           qed
         qed
       qed
       text \<open>
         Because of the way the function package processes the pattern matching in the
         definition of \<open>stdz_insert\<close>, it produces eight separate subgoals for the remainder
         of the proof, even though these subgoals are all simple consequences of a single,
         more general fact.  We first prove this fact, then use it to discharge the eight
         subgoals.
       \<close>
       have *: "\<And>M N u U.
                  \<lbrakk>\<not> (\<Lambda>.is_Lam M \<and> \<Lambda>.is_Beta u);
                   \<Lambda>.Ide (M \<^bold>\<circ> N) \<Longrightarrow> ?P (hd (u # U)) (tl (u # U));
                   \<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N);
                    \<Lambda>.seq (M \<^bold>\<circ> N) (hd (u # U));
                    \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
                    \<Lambda>.Ide (\<Lambda>.resid (M \<^bold>\<circ> N) (\<Lambda>.head_redex (M \<^bold>\<circ> N)))\<rbrakk>
                       \<Longrightarrow> ?P (hd (u # U)) (tl (u # U));
                   \<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N);
                    \<Lambda>.seq (M \<^bold>\<circ> N) (hd (u # U));
                    \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
                    \<not> \<Lambda>.Ide (\<Lambda>.resid (M \<^bold>\<circ> N) (\<Lambda>.head_redex (M \<^bold>\<circ> N)))\<rbrakk>
                       \<Longrightarrow> ?P (\<Lambda>.resid (M \<^bold>\<circ> N) (\<Lambda>.head_redex (M \<^bold>\<circ> N))) (u # U);
                   \<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N);
                    \<Lambda>.seq (M \<^bold>\<circ> N) (hd (u # U));
                    \<not> \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
                    \<Lambda>.contains_head_reduction (hd (u # U));
                    \<Lambda>.Ide (\<Lambda>.resid (M \<^bold>\<circ> N) (\<Lambda>.head_strategy (M \<^bold>\<circ> N)))\<rbrakk>
                       \<Longrightarrow> ?P (\<Lambda>.head_strategy (M \<^bold>\<circ> N)) (tl (u # U));
                   \<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N);
                    \<Lambda>.seq (M \<^bold>\<circ> N) (hd (u # U));
                    \<not> \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
                    \<Lambda>.contains_head_reduction (hd (u # U));
                    \<not> \<Lambda>.Ide (\<Lambda>.resid (M \<^bold>\<circ> N) (\<Lambda>.head_strategy (M \<^bold>\<circ> N)))\<rbrakk>
                       \<Longrightarrow> ?P (\<Lambda>.resid (M \<^bold>\<circ> N) (\<Lambda>.head_strategy (M \<^bold>\<circ> N))) (tl (u # U));
                   \<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N);
                    \<Lambda>.seq (M \<^bold>\<circ> N) (hd (u # U));
                    \<not> \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
                    \<not> \<Lambda>.contains_head_reduction (hd (u # U))\<rbrakk>
                       \<Longrightarrow> ?P M (filter notIde (map \<Lambda>.un_App1 (u # U)));
                   \<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N);
                    \<Lambda>.seq (M \<^bold>\<circ> N) (hd (u # U));
                    \<not> \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
                    \<not> \<Lambda>.contains_head_reduction (hd (u # U))\<rbrakk>
                       \<Longrightarrow> ?P N (filter notIde (map \<Lambda>.un_App2 (u # U)))\<rbrakk>
                     \<Longrightarrow> ?P (M \<^bold>\<circ> N) (u # U)"
       proof -
         fix M N u U
         assume ind1: "\<Lambda>.Ide (M \<^bold>\<circ> N) \<Longrightarrow> ?P (hd (u # U)) (tl (u # U))"
         assume ind2: "\<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N);
                        \<Lambda>.seq (M \<^bold>\<circ> N) (hd (u # U));
                        \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
                        \<Lambda>.Ide (\<Lambda>.resid (M \<^bold>\<circ> N) (\<Lambda>.head_redex (M \<^bold>\<circ> N)))\<rbrakk>
                           \<Longrightarrow> ?P (hd (u # U)) (tl (u # U))"
         assume ind3: "\<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N);
                        \<Lambda>.seq (M \<^bold>\<circ> N) (hd (u # U));
                        \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
                        \<not> \<Lambda>.Ide (\<Lambda>.resid (M \<^bold>\<circ> N) (\<Lambda>.head_redex (M \<^bold>\<circ> N)))\<rbrakk>
                           \<Longrightarrow> ?P (\<Lambda>.resid (M \<^bold>\<circ> N) (\<Lambda>.head_redex (M \<^bold>\<circ> N))) (u # U)"
         assume ind4: "\<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N);
                        \<Lambda>.seq (M \<^bold>\<circ> N) (hd (u # U));
                        \<not> \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
                        \<Lambda>.contains_head_reduction (hd (u # U));
                        \<Lambda>.Ide (\<Lambda>.resid (M \<^bold>\<circ> N) (\<Lambda>.head_strategy (M \<^bold>\<circ> N)))\<rbrakk>
                          \<Longrightarrow> ?P (\<Lambda>.head_strategy (M \<^bold>\<circ> N)) (tl (u # U))"
         assume ind5: "\<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N);
                        \<Lambda>.seq (M \<^bold>\<circ> N) (hd (u # U));
                        \<not> \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
                        \<Lambda>.contains_head_reduction (hd (u # U));
                        \<not> \<Lambda>.Ide (\<Lambda>.resid (M \<^bold>\<circ> N) (\<Lambda>.head_strategy (M \<^bold>\<circ> N)))\<rbrakk>
                           \<Longrightarrow> ?P (\<Lambda>.resid (M \<^bold>\<circ> N) (\<Lambda>.head_strategy (M \<^bold>\<circ> N))) (tl (u # U))"
         assume ind7: "\<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N);
                        \<Lambda>.seq (M \<^bold>\<circ> N) (hd (u # U));
                        \<not> \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
                        \<not> \<Lambda>.contains_head_reduction (hd (u # U))\<rbrakk>
                           \<Longrightarrow> ?P M (filter notIde (map \<Lambda>.un_App1 (u # U)))"
         assume ind8: "\<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N);
                        \<Lambda>.seq (M \<^bold>\<circ> N) (hd (u # U));
                        \<not> \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
                        \<not> \<Lambda>.contains_head_reduction (hd (u # U))\<rbrakk>
                           \<Longrightarrow> ?P N (filter notIde (map \<Lambda>.un_App2 (u # U)))"
         assume *: "\<not> (\<Lambda>.is_Lam M \<and> \<Lambda>.is_Beta u)"
         show "?P (M \<^bold>\<circ> N) (u # U)"
         proof (intro impI, elim conjE)
           assume seq: "seq [M \<^bold>\<circ> N] (u # U)"
           assume Std: "Std (u # U)"
           have MN: "\<Lambda>.Arr M \<and> \<Lambda>.Arr N"
             using seq_char seq by force
           have u: "\<Lambda>.Arr u"
             using Std
             by (meson Std_imp_Arr Arr.simps(2) Con_Arr_self Con_implies_Arr(1)
                 Con_initial_left \<Lambda>.arr_char list.simps(3))
           have "U \<noteq> [] \<Longrightarrow> Arr U"
             using Std Std_imp_Arr Arr.simps(3)
             by (metis Arr.elims(3) list.discI)
           have "\<Lambda>.is_App u \<or> \<Lambda>.is_Beta u"
             using * seq MN u seq_char \<Lambda>.arr_char Srcs_simp\<^sub>\<Lambda>\<^sub>P \<Lambda>.targets_char\<^sub>\<Lambda>
             by (cases M; cases u) auto
           have **: "\<Lambda>.seq (M \<^bold>\<circ> N) u"
             using Srcs_simp\<^sub>\<Lambda>\<^sub>P seq_char seq \<Lambda>.seq_def u by force
           show "Std (stdz_insert (M \<^bold>\<circ> N) (u # U)) \<and>
                 (\<not> Ide ((M \<^bold>\<circ> N) # u # U)
                     \<longrightarrow> cong (stdz_insert (M \<^bold>\<circ> N) (u # U)) ((M \<^bold>\<circ> N) # u # U))"
           proof (cases "\<Lambda>.Ide (M \<^bold>\<circ> N)")
             assume 1: "\<Lambda>.Ide (M \<^bold>\<circ> N)"
             have MN: "\<Lambda>.Arr M \<and> \<Lambda>.Arr N \<and> \<Lambda>.Ide M \<and> \<Lambda>.Ide N"
               using MN 1 by simp
             have 2: "stdz_insert (M \<^bold>\<circ> N) (u # U) = stdz_insert u U"
               using MN 1
               by (simp add: Std seq stdz_insert_Ide_Std)
             show ?thesis
             proof (cases "U = []")
               assume U: "U = []"
               have 2: "stdz_insert (M \<^bold>\<circ> N) (u # U) = standard_development u"
                 using 1 2 U by simp
               show ?thesis
               proof (intro conjI)
                 show "Std (stdz_insert (M \<^bold>\<circ> N) (u # U))"
                   using "2" Std_standard_development by presburger
                 show "\<not> Ide ((M \<^bold>\<circ> N) # u # U) \<longrightarrow>
                           stdz_insert (M \<^bold>\<circ> N) (u # U) \<^sup>*\<sim>\<^sup>* (M \<^bold>\<circ> N) # u # U"
                   by (metis "1" "2" Ide.simps(2) U cong_cons_ideI(1) cong_standard_development
                       ide_backward_stable ide_char \<Lambda>.ide_char prfx_transitive seq u)
               qed
               next
               assume U: "U \<noteq> []"
               have 2: "stdz_insert (M \<^bold>\<circ> N) (u # U) = stdz_insert u U"
                 using 1 2 U by simp
               have 3: "seq [u] U"
                 by (simp add: Std U arrI\<^sub>P arr_append_imp_seq)
               have 4: "Std (stdz_insert u U) \<and>
                        set (stdz_insert u U) \<subseteq> {a. \<Lambda>.elementary_reduction a} \<and>
                        (\<not> Ide (u # U) \<longrightarrow> cong (stdz_insert u U) (u # U))"
                 using MN 3 Std ind1 Std_implies_set_subset_elementary_reduction
                 by (metis "1" Std.simps(3) U list.sel(1) list.sel(3) standardize.cases)
               show ?thesis
               proof (intro conjI)
                 show "Std (stdz_insert (M \<^bold>\<circ> N) (u # U))"
                   by (metis "1" "2" "3" Std Std.simps(3) U ind1 list.exhaust_sel list.sel(1,3))
                 show "\<not> Ide ((M \<^bold>\<circ> N) # u # U) \<longrightarrow>
                           stdz_insert (M \<^bold>\<circ> N) (u # U) \<^sup>*\<sim>\<^sup>* (M \<^bold>\<circ> N) # u # U"
                 proof
                   assume 5: "\<not> Ide ((M \<^bold>\<circ> N) # u # U)"
                   have "stdz_insert (M \<^bold>\<circ> N) (u # U) \<^sup>*\<sim>\<^sup>* u # U"
                     using "1" "2" "4" "5" seq_char seq by force
                   also have "u # U \<^sup>*\<sim>\<^sup>* [M \<^bold>\<circ> N] @ u # U"
                     using "1" Ide.simps(2) cong_append_ideI(1) ide_char seq by blast
                   also have "[M \<^bold>\<circ> N] @ (u # U) = (M \<^bold>\<circ> N) # u # U"
                     by simp
                   finally show "stdz_insert (M \<^bold>\<circ> N) (u # U) \<^sup>*\<sim>\<^sup>* (M \<^bold>\<circ> N) # u # U"
                     by blast
                 qed
               qed
             qed
             next
             assume 1: "\<not> \<Lambda>.Ide (M \<^bold>\<circ> N)"
             show ?thesis
             proof (cases "\<Lambda>.contains_head_reduction (M \<^bold>\<circ> N)")
               assume 2: "\<Lambda>.contains_head_reduction (M \<^bold>\<circ> N)"
               show ?thesis
               proof (cases "\<Lambda>.Ide ((M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N))")
                 assume 3: "\<Lambda>.Ide ((M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N))"
                 have 4: "\<not> Ide (u # U)"
                   by (metis Std Std_implies_set_subset_elementary_reduction in_mono
                       \<Lambda>.elementary_reduction_not_ide list.set_intros(1) mem_Collect_eq
                       set_Ide_subset_ide)
                 have 5: "stdz_insert (M \<^bold>\<circ> N) (u # U) = \<Lambda>.head_redex (M \<^bold>\<circ> N) # stdz_insert u U"
                   using MN 1 2 3 4 ** by auto
                 show ?thesis
                 proof (cases "U = []")
                   assume U: "U = []"
                   have u: "\<Lambda>.Arr u \<and> \<not> \<Lambda>.Ide u"
                       using 4 U u by force
                   have 5: "stdz_insert (M \<^bold>\<circ> N) (u # U) =
                            \<Lambda>.head_redex (M \<^bold>\<circ> N) # standard_development u"
                     using 5 U by simp
                   show ?thesis
                   proof (intro conjI)
                     show "Std (stdz_insert (M \<^bold>\<circ> N) (u # U))"
                     proof -
                       have "\<Lambda>.sseq (\<Lambda>.head_redex (M \<^bold>\<circ> N)) (hd (standard_development u))"
                       proof -
                         have "\<Lambda>.seq (\<Lambda>.head_redex (M \<^bold>\<circ> N)) (hd (standard_development u))"
                         proof
                           show "\<Lambda>.Arr (\<Lambda>.head_redex (M \<^bold>\<circ> N))"
                             using MN \<Lambda>.Arr.simps(4) \<Lambda>.Arr_head_redex by presburger
                           show "\<Lambda>.Arr (hd (standard_development u))"
                             using Arr_imp_arr_hd Ide_iff_standard_development_empty
                                   Std_standard_development u
                             by force
                           show "\<Lambda>.Trg (\<Lambda>.head_redex (M \<^bold>\<circ> N)) = \<Lambda>.Src (hd (standard_development u))"
                           proof -
                             have "\<Lambda>.Trg (\<Lambda>.head_redex (M \<^bold>\<circ> N)) =
                                   \<Lambda>.Trg ((M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N))"
                               by (metis 3 MN \<Lambda>.Con_Arr_head_redex \<Lambda>.Src_resid
                                   \<Lambda>.Arr.simps(4) \<Lambda>.Ide_iff_Src_self \<Lambda>.Ide_iff_Trg_self
                                   \<Lambda>.Ide_implies_Arr)
                             also have "... = \<Lambda>.Src u"
                               using MN
                               by (metis Trg_last_Src_hd_eqI Trg_last_eqI head_redex_decomp
                                   \<Lambda>.Arr.simps(4) last_ConsL last_appendR list.sel(1)
                                   not_Cons_self2 seq)
                             also have "... = \<Lambda>.Src (hd (standard_development u))"
                               using ** 2 3 u MN Src_hd_standard_development [of u] by metis
                             finally show ?thesis by blast
                           qed
                         qed
                         thus ?thesis
                           by (metis 2 u MN \<Lambda>.Arr.simps(4) Ide_iff_standard_development_empty
                               development.simps(2) development_standard_development
                               \<Lambda>.head_redex_is_head_reduction list.exhaust_sel
                               \<Lambda>.sseq_head_reductionI)
                       qed
                       thus ?thesis
                         by (metis 5 Ide_iff_standard_development_empty Std.simps(3)
                             Std_standard_development list.exhaust u)
                     qed
                     show "\<not> Ide ((M \<^bold>\<circ> N) # u # U) \<longrightarrow>
                               stdz_insert (M \<^bold>\<circ> N) (u # U) \<^sup>*\<sim>\<^sup>* (M \<^bold>\<circ> N) # u # U"
                     proof
                       have "stdz_insert (M \<^bold>\<circ> N) (u # U) =
                             [\<Lambda>.head_redex (M \<^bold>\<circ> N)] @ standard_development u"
                         using 5 by simp
                       also have "... \<^sup>*\<sim>\<^sup>* [\<Lambda>.head_redex (M \<^bold>\<circ> N)] @ [u]"
                         using u cong_standard_development [of u] cong_append
                         by (metis 2 5 Ide_iff_standard_development_empty Std_imp_Arr
                             \<open>Std (stdz_insert (M \<^bold>\<circ> N) (u # U))\<close>
                             arr_append_imp_seq arr_char calculation cong_standard_development
                             cong_transitive \<Lambda>.Arr_head_redex \<Lambda>.contains_head_reduction_iff
                             list.distinct(1))
                       also have "[\<Lambda>.head_redex (M \<^bold>\<circ> N)] @ [u] \<^sup>*\<sim>\<^sup>*
                                  ([\<Lambda>.head_redex (M \<^bold>\<circ> N)] @ [(M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N)]) @ [u]"
                       proof -
                         have "[\<Lambda>.head_redex (M \<^bold>\<circ> N)] \<^sup>*\<sim>\<^sup>*
                               [\<Lambda>.head_redex (M \<^bold>\<circ> N)] @ [(M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N)]"
                           by (metis (no_types, lifting) 1 3 MN Arr_iff_Con_self Ide.simps(2)
                               Resid.simps(2) arr_append_imp_seq arr_char cong_append_ideI(4)
                               cong_transitive head_redex_decomp ide_backward_stable ide_char
                               \<Lambda>.Arr.simps(4) \<Lambda>.ide_char not_Cons_self2)
                         thus ?thesis
                           using MN U u seq
                           by (meson cong_append head_redex_decomp \<Lambda>.Arr.simps(4) prfx_transitive)
                       qed
                       also have "([\<Lambda>.head_redex (M \<^bold>\<circ> N)] @
                                     [(M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N)]) @ [u] \<^sup>*\<sim>\<^sup>*
                                  [M \<^bold>\<circ> N] @ [u]"
                         by (metis \<Lambda>.Arr.simps(4) MN U Resid_Arr_self cong_append ide_char
                             seq_char head_redex_decomp seq)
                       also have "[M \<^bold>\<circ> N] @ [u] = (M \<^bold>\<circ> N) # u # U"
                         using U by simp
                       finally show "stdz_insert (M \<^bold>\<circ> N) (u # U) \<^sup>*\<sim>\<^sup>* (M \<^bold>\<circ> N) # u # U"
                         by blast
                     qed
                   qed
                   next
                   assume U: "U \<noteq> []"
                   have 6: "Std (stdz_insert u U) \<and>
                            set (stdz_insert u U) \<subseteq> {a. \<Lambda>.elementary_reduction a} \<and>
                            cong (stdz_insert u U) (u # U)"
                   proof -
                     have "seq [u] U"
                       by (simp add: Std U arrI\<^sub>P arr_append_imp_seq)
                     moreover have "Std U"
                       using Std Std.elims(2) U by blast
                     ultimately show ?thesis
                       using ind2 ** 1 2 3 4 Std_implies_set_subset_elementary_reduction
                       by force
                   qed
                   show ?thesis
                   proof (intro conjI)
                     show "Std (stdz_insert (M \<^bold>\<circ> N) (u # U))"
                     proof -
                       have "\<Lambda>.sseq (\<Lambda>.head_redex (M \<^bold>\<circ> N)) (hd (stdz_insert u U))"
                       proof -
                         have "\<Lambda>.seq (\<Lambda>.head_redex (M \<^bold>\<circ> N)) (hd (stdz_insert u U))"
                         proof
                           show "\<Lambda>.Arr (\<Lambda>.head_redex (M \<^bold>\<circ> N))"
                             using MN \<Lambda>.Arr_head_redex by force
                           show "\<Lambda>.Arr (hd (stdz_insert u U))"
                             using 6
                             by (metis Arr_imp_arr_hd Con_implies_Arr(2) Ide.simps(1) ide_char
                                 \<Lambda>.arr_char)
                           show "\<Lambda>.Trg (\<Lambda>.head_redex (M \<^bold>\<circ> N)) = \<Lambda>.Src (hd (stdz_insert u U))"
                           proof -
                             have "\<Lambda>.Trg (\<Lambda>.head_redex (M \<^bold>\<circ> N)) =
                                   \<Lambda>.Trg ((M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N))"
                               by (metis 3 \<Lambda>.Arr_not_Nil \<Lambda>.Ide_iff_Src_self
                                   \<Lambda>.Ide_iff_Trg_self \<Lambda>.Ide_implies_Arr \<Lambda>.Src_resid)
                             also have "... = \<Lambda>.Trg (M \<^bold>\<circ> N)"
                               by (metis 1 MN Trg_last_eqI Trg_last_standard_development
                                   cong_standard_development head_redex_decomp \<Lambda>.Arr.simps(4)
                                   last_snoc)
                             also have "... = \<Lambda>.Src (hd (stdz_insert u U))"
                               by (metis ** 6 Src_hd_eqI \<Lambda>.seqE\<^sub>\<Lambda> list.sel(1))
                             finally show ?thesis by blast
                           qed
                         qed
                         thus ?thesis
                           by (metis 2 6 MN \<Lambda>.Arr.simps(4) Std.elims(1) Ide.simps(1)
                               Resid.simps(2) ide_char \<Lambda>.head_redex_is_head_reduction
                               list.sel(1) \<Lambda>.sseq_head_reductionI \<Lambda>.sseq_imp_elementary_reduction1)
                       qed
                       thus ?thesis
                         by (metis 5 6 Std.simps(3) Arr.simps(1) Con_implies_Arr(1)
                             con_char prfx_implies_con list.exhaust_sel)
                     qed
                     show "\<not> Ide ((M \<^bold>\<circ> N) # u # U) \<longrightarrow>
                               stdz_insert (M \<^bold>\<circ> N) (u # U) \<^sup>*\<sim>\<^sup>* (M \<^bold>\<circ> N) # u # U"
                     proof
                       have "stdz_insert (M \<^bold>\<circ> N) (u # U) =
                             [\<Lambda>.head_redex (M \<^bold>\<circ> N)] @ stdz_insert u U"
                         using 5 by simp
                       also have 7: "[\<Lambda>.head_redex (M \<^bold>\<circ> N)] @ stdz_insert u U \<^sup>*\<sim>\<^sup>*
                                     [\<Lambda>.head_redex (M \<^bold>\<circ> N)] @ u # U"
                         using 6 cong_append [of "[\<Lambda>.head_redex (M \<^bold>\<circ> N)]" "stdz_insert u U"
                                                 "[\<Lambda>.head_redex (M \<^bold>\<circ> N)]" "u # U"]
                         by (metis 2 5 Arr.simps(1) Resid.simps(2) Std_imp_Arr
                             \<open>Std (stdz_insert (M \<^bold>\<circ> N) (u # U))\<close>
                             arr_append_imp_seq arr_char calculation cong_standard_development
                             cong_transitive ide_implies_arr \<Lambda>.Arr_head_redex
                             \<Lambda>.contains_head_reduction_iff list.distinct(1))
                       also have "[\<Lambda>.head_redex (M \<^bold>\<circ> N)] @ u # U \<^sup>*\<sim>\<^sup>*
                                  ([\<Lambda>.head_redex (M \<^bold>\<circ> N)] @
                                     [(M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N)]) @ u # U"
                       proof -
                         have "[\<Lambda>.head_redex (M \<^bold>\<circ> N)] \<^sup>*\<sim>\<^sup>*
                               [\<Lambda>.head_redex (M \<^bold>\<circ> N)] @ [(M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N)]"
                           by (metis 2 3 head_redex_decomp \<Lambda>.Arr_head_redex
                               \<Lambda>.Con_Arr_head_redex \<Lambda>.Ide_iff_Src_self \<Lambda>.Ide_implies_Arr
                               \<Lambda>.Src_resid \<Lambda>.contains_head_reduction_iff \<Lambda>.resid_Arr_self
                               prfx_decomp prfx_transitive)
                         moreover have "seq [\<Lambda>.head_redex (M \<^bold>\<circ> N)] (u # U)"
                           by (metis 7 arr_append_imp_seq cong_implies_coterminal coterminalE
                               list.distinct(1))
                         ultimately show ?thesis
                           using 3 ide_char cong_symmetric cong_append
                           by (meson 6 prfx_transitive)
                       qed
                       also have "([\<Lambda>.head_redex (M \<^bold>\<circ> N)] @
                                     [(M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N)]) @ u # U \<^sup>*\<sim>\<^sup>*
                                  [M \<^bold>\<circ> N] @ u # U"
                         by (meson 6 MN \<Lambda>.Arr.simps(4) cong_append prfx_transitive
                             head_redex_decomp seq)
                       also have "[M \<^bold>\<circ> N] @ (u # U) = (M \<^bold>\<circ> N) # u # U"
                         by simp
                       finally show "stdz_insert (M \<^bold>\<circ> N) (u # U) \<^sup>*\<sim>\<^sup>* (M \<^bold>\<circ> N) # u # U"
                         by blast
                     qed
                   qed
                 qed
                 next
                 assume 3: "\<not> \<Lambda>.Ide ((M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N))"
                 have 4: "stdz_insert (M \<^bold>\<circ> N) (u # U) =
                          \<Lambda>.head_redex (M \<^bold>\<circ> N) #
                            stdz_insert ((M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N)) (u # U)"
                   using MN 1 2 3 ** by auto
                 have 5: "Std (stdz_insert ((M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N)) (u # U)) \<and>
                          set (stdz_insert ((M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N)) (u # U))
                             \<subseteq> {a. \<Lambda>.elementary_reduction a} \<and>
                          stdz_insert ((M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N)) (u # U) \<^sup>*\<sim>\<^sup>*
                          (M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N) # u # U"
                 proof -
                   have "seq [(M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N)] (u # U)"
                     by (metis (full_types) MN arr_append_imp_seq cong_implies_coterminal
                         coterminalE head_redex_decomp \<Lambda>.Arr.simps(4) not_Cons_self2
                         seq seq_def targets_append)
                   thus ?thesis
                     using ind3 1 2 3 ** Std Std_implies_set_subset_elementary_reduction
                     by auto
                 qed
                 show ?thesis
                 proof (intro conjI)
                   show "Std (stdz_insert (M \<^bold>\<circ> N) (u # U))"
                   proof -
                     have "\<Lambda>.sseq (\<Lambda>.head_redex (M \<^bold>\<circ> N))
                                  (hd (stdz_insert ((M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N)) (u # U)))"
                     proof -
                       have "\<Lambda>.seq (\<Lambda>.head_redex (M \<^bold>\<circ> N))
                                   (hd (stdz_insert ((M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N)) (u # U)))"
                         using MN 5 \<Lambda>.Arr_head_redex
                         by (metis (no_types, lifting) Arr_imp_arr_hd Con_implies_Arr(2)
                             Ide.simps(1) Src_hd_eqI ide_char \<Lambda>.Arr.simps(4) \<Lambda>.Arr_head_redex
                             \<Lambda>.Con_Arr_head_redex \<Lambda>.Src_resid \<Lambda>.arr_char \<Lambda>.seq_char list.sel(1))
                       moreover have "\<Lambda>.elementary_reduction
                                        (hd (stdz_insert ((M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N))
                                                         (u # U)))"
                         using 5
                         by (metis Arr.simps(1) Con_implies_Arr(2) Ide.simps(1) hd_in_set
                             ide_char mem_Collect_eq subset_code(1))
                       ultimately show ?thesis
                         using MN 2 \<Lambda>.head_redex_is_head_reduction \<Lambda>.sseq_head_reductionI
                         by simp
                     qed
                     thus ?thesis
                       by (metis 4 5 Std.simps(3) Arr.simps(1) Con_implies_Arr(2)
                           Ide.simps(1) ide_char list.exhaust_sel)
                   qed
                   show "\<not> Ide ((M \<^bold>\<circ> N) # u # U) \<longrightarrow>
                              stdz_insert (M \<^bold>\<circ> N) (u # U) \<^sup>*\<sim>\<^sup>* (M \<^bold>\<circ> N) # u # U"
                   proof
                     have "stdz_insert (M \<^bold>\<circ> N) (u # U) =
                          [\<Lambda>.head_redex (M \<^bold>\<circ> N)] @
                            stdz_insert ((M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N)) (u # U)"
                       using 4 by simp
                     also have "... \<^sup>*\<sim>\<^sup>* [\<Lambda>.head_redex (M \<^bold>\<circ> N)] @
                                          ((M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N) # u # U)"
                     proof (intro cong_append)
                       show "seq [\<Lambda>.head_redex (M \<^bold>\<circ> N)]
                                 (stdz_insert ((M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N)) (u # U))"
                         by (metis 4 5 Ide.simps(1) Resid.simps(1) Std_imp_Arr
                             \<open>Std (stdz_insert (M \<^bold>\<circ> N) (u # U))\<close> arrI\<^sub>P arr_append_imp_seq
                             calculation ide_char list.discI)
                       show "[\<Lambda>.head_redex (M \<^bold>\<circ> N)] \<^sup>*\<sim>\<^sup>* [\<Lambda>.head_redex (M \<^bold>\<circ> N)]"
                         using MN \<Lambda>.cong_reflexive ide_char \<Lambda>.Arr_head_redex by force
                       show "stdz_insert ((M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N)) (u # U) \<^sup>*\<sim>\<^sup>* (M \<^bold>\<circ> N) \\
                             \<Lambda>.head_redex (M \<^bold>\<circ> N) # u # U"
                         using 5 by fastforce
                     qed
                     also have "([\<Lambda>.head_redex (M \<^bold>\<circ> N)] @
                                  ((M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N) # u # U)) =
                                ([\<Lambda>.head_redex (M \<^bold>\<circ> N)] @
                                   [(M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N)]) @ (u # U)"
                       by simp
                     also have "([\<Lambda>.head_redex (M \<^bold>\<circ> N)] @
                                  [(M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N)]) @ u # U \<^sup>*\<sim>\<^sup>*
                                [M \<^bold>\<circ> N] @ u # U"
                       by (meson ** cong_append cong_reflexive seqE head_redex_decomp
                           seq \<Lambda>.seq_char)
                     also have "[M \<^bold>\<circ> N] @ (u # U) = (M \<^bold>\<circ> N) # u # U"
                       by simp
                     finally show "stdz_insert (M \<^bold>\<circ> N) (u # U) \<^sup>*\<sim>\<^sup>* (M \<^bold>\<circ> N) # u # U"
                       by blast
                   qed
                 qed
               qed
               next
               assume 2: "\<not> \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N)"
               show ?thesis
               proof (cases "\<Lambda>.contains_head_reduction u")
                 assume 3: "\<Lambda>.contains_head_reduction u"
                 have B: "[\<Lambda>.head_strategy (M \<^bold>\<circ> N)] @ [(M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N)] \<^sup>*\<sim>\<^sup>*
                          [M \<^bold>\<circ> N] @ [u]"
                 proof -
                   have "[M \<^bold>\<circ> N] @ [u] \<^sup>*\<sim>\<^sup>* [\<Lambda>.head_strategy (\<Lambda>.Src (M \<^bold>\<circ> N)) \<squnion> M \<^bold>\<circ> N]"
                   proof -
                     have "\<Lambda>.is_internal_reduction (M \<^bold>\<circ> N)"
                       using 2 ** \<Lambda>.is_internal_reduction_iff by blast
                     moreover have "\<Lambda>.is_head_reduction u"
                     proof -
                       have "\<Lambda>.elementary_reduction u"
                         by (metis Std lambda_calculus.sseq_imp_elementary_reduction1
                             list.discI list.sel(1) reduction_paths.Std.elims(2))
                       thus ?thesis
                         using \<Lambda>.is_head_reduction_if 3 by force
                     qed
                     moreover have "\<Lambda>.head_strategy (\<Lambda>.Src (M \<^bold>\<circ> N)) \\ (M \<^bold>\<circ> N) = u"
                       using \<Lambda>.resid_head_strategy_Src(1) ** calculation(1-2) by fastforce
                     moreover have "[M \<^bold>\<circ> N] \<^sup>*\<lesssim>\<^sup>* [\<Lambda>.head_strategy (\<Lambda>.Src (M \<^bold>\<circ> N)) \<squnion> M \<^bold>\<circ> N]"
                       using MN \<Lambda>.prfx_implies_con ide_char \<Lambda>.Arr_head_strategy
                             \<Lambda>.Src_head_strategy \<Lambda>.prfx_Join
                       by force
                     ultimately show ?thesis
                       using u \<Lambda>.Coinitial_iff_Con \<Lambda>.Arr_not_Nil \<Lambda>.resid_Join
                             prfx_decomp [of "M \<^bold>\<circ> N" "\<Lambda>.head_strategy (\<Lambda>.Src (M \<^bold>\<circ> N)) \<squnion> M \<^bold>\<circ> N"]
                       by simp
                   qed
                   also have "[\<Lambda>.head_strategy (\<Lambda>.Src (M \<^bold>\<circ> N)) \<squnion> M \<^bold>\<circ> N] \<^sup>*\<sim>\<^sup>*
                              [\<Lambda>.head_strategy (\<Lambda>.Src (M \<^bold>\<circ> N))] @
                                [(M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (\<Lambda>.Src (M \<^bold>\<circ> N))]"
                   proof -
                     have 3: "\<Lambda>.composite_of
                                (\<Lambda>.head_strategy (\<Lambda>.Src (M \<^bold>\<circ> N)))
                                ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (\<Lambda>.Src (M \<^bold>\<circ> N)))
                                (\<Lambda>.head_strategy (\<Lambda>.Src (M \<^bold>\<circ> N)) \<squnion> M \<^bold>\<circ> N)"
                       using \<Lambda>.Arr_head_strategy MN \<Lambda>.Src_head_strategy \<Lambda>.join_of_Join
                             \<Lambda>.join_of_def
                       by force
                     hence "composite_of
                              [\<Lambda>.head_strategy (\<Lambda>.Src (M \<^bold>\<circ> N))]
                              [(M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (\<Lambda>.Src (M \<^bold>\<circ> N))]
                              [\<Lambda>.head_strategy (\<Lambda>.Src (M \<^bold>\<circ> N)) \<squnion> M \<^bold>\<circ> N]"
                       using composite_of_single_single
                       by (metis (no_types, lifting) \<Lambda>.Con_sym Ide.simps(2) Resid.simps(3)
                           composite_ofI \<Lambda>.composite_ofE \<Lambda>.con_char ide_char \<Lambda>.prfx_implies_con)
                     hence "[\<Lambda>.head_strategy (\<Lambda>.Src (M \<^bold>\<circ> N))] @
                              [(M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (\<Lambda>.Src (M \<^bold>\<circ> N))] \<^sup>*\<sim>\<^sup>*
                            [\<Lambda>.head_strategy (\<Lambda>.Src (M \<^bold>\<circ> N)) \<squnion> M \<^bold>\<circ> N]"
                       using \<Lambda>.resid_Join
                       by (meson 3 composite_of_single_single composite_of_unq_upto_cong)
                     thus ?thesis by blast
                   qed
                   also have "[\<Lambda>.head_strategy (\<Lambda>.Src (M \<^bold>\<circ> N))] @
                                [(M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (\<Lambda>.Src (M \<^bold>\<circ> N))] \<^sup>*\<sim>\<^sup>*
                              [\<Lambda>.head_strategy (M \<^bold>\<circ> N)] @
                                [(M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N)]"
                     by (metis (full_types) \<Lambda>.Arr.simps(4) MN prfx_transitive calculation
                         \<Lambda>.head_strategy_Src)
                   finally show ?thesis by blast
                 qed
                 show ?thesis
                 proof (cases "\<Lambda>.Ide ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N))")
                   assume 4: "\<Lambda>.Ide ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N))"
                   have A: "[\<Lambda>.head_strategy (M \<^bold>\<circ> N)] \<^sup>*\<sim>\<^sup>*
                            [\<Lambda>.head_strategy (M \<^bold>\<circ> N)] @ [(M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N)]"
                     by (meson 4 B Con_implies_Arr(1) Ide.simps(2) arr_append_imp_seq arr_char
                         con_char cong_append_ideI(2) ide_char \<Lambda>.ide_char not_Cons_self2
                         prfx_implies_con)
                   have 5: "\<not> Ide (u # U)"
                     by (meson 3 Ide_consE \<Lambda>.ide_backward_stable \<Lambda>.subs_head_redex
                         \<Lambda>.subs_implies_prfx \<Lambda>.contains_head_reduction_iff
                         \<Lambda>.elementary_reduction_head_redex \<Lambda>.elementary_reduction_not_ide)
                   have 6: "stdz_insert (M \<^bold>\<circ> N) (u # U) =
                            stdz_insert (\<Lambda>.head_strategy (M \<^bold>\<circ> N)) U"
                     using 1 2 3 4 5 * ** \<open>\<Lambda>.is_App u \<or> \<Lambda>.is_Beta u\<close>
                     apply (cases u)
                         apply simp_all
                      apply blast
                     by (cases M) auto
                   show ?thesis
                   proof (cases "U = []")
                     assume U: "U = []"
                     have u: "\<not> \<Lambda>.Ide u"
                       using 5 U by simp
                     have 6: "stdz_insert (M \<^bold>\<circ> N) (u # U) =
                              standard_development (\<Lambda>.head_strategy (M \<^bold>\<circ> N))"
                       using 6 U by simp
                     show ?thesis
                     proof (intro conjI)
                       show "Std (stdz_insert (M \<^bold>\<circ> N) (u # U))"
                         using "6" Std_standard_development by presburger
                       show "\<not> Ide ((M \<^bold>\<circ> N) # u # U) \<longrightarrow>
                                 stdz_insert (M \<^bold>\<circ> N) (u # U) \<^sup>*\<sim>\<^sup>* (M \<^bold>\<circ> N) # u # U"
                       proof
                         have "stdz_insert (M \<^bold>\<circ> N) (u # U) \<^sup>*\<sim>\<^sup>* [\<Lambda>.head_strategy (M \<^bold>\<circ> N)]"
                           using 4 6 cong_standard_development ** 1 2 3 \<Lambda>.Arr.simps(4)
                                 \<Lambda>.Arr_head_strategy MN \<Lambda>.ide_backward_stable \<Lambda>.ide_char
                           by metis
                         also have "[\<Lambda>.head_strategy (M \<^bold>\<circ> N)] \<^sup>*\<sim>\<^sup>* [M \<^bold>\<circ> N] @ [u]"
                           by (meson A B prfx_transitive)
                         also have "[M \<^bold>\<circ> N] @ [u] = (M \<^bold>\<circ> N) # u # U"
                           using U by auto
                         finally show "stdz_insert (M \<^bold>\<circ> N) (u # U) \<^sup>*\<sim>\<^sup>* (M \<^bold>\<circ> N) # u # U"
                           by blast
                       qed
                     qed
                     next
                     assume U: "U \<noteq> []"
                     have 7: "seq [\<Lambda>.head_strategy (M \<^bold>\<circ> N)] U"
                     proof
                       show "Arr [\<Lambda>.head_strategy (M \<^bold>\<circ> N)]"
                         by (meson A Con_implies_Arr(1) con_char prfx_implies_con)
                       show "Arr U"
                         using U \<open>U \<noteq> [] \<Longrightarrow> Arr U\<close> by presburger
                       show "\<Lambda>.Trg (last [\<Lambda>.head_strategy (M \<^bold>\<circ> N)]) = \<Lambda>.Src (hd U)"
                         by (metis A B Std Std_consE Trg_last_eqI U \<Lambda>.seqE\<^sub>\<Lambda> \<Lambda>.sseq_imp_seq last_snoc)
                     qed
                     have 8: "Std (stdz_insert (\<Lambda>.head_strategy (M \<^bold>\<circ> N)) U) \<and>
                              set (stdz_insert (\<Lambda>.head_strategy (M \<^bold>\<circ> N)) U)
                                 \<subseteq> {a. \<Lambda>.elementary_reduction a} \<and>
                              stdz_insert (\<Lambda>.head_strategy (M \<^bold>\<circ> N)) U \<^sup>*\<sim>\<^sup>*
                              \<Lambda>.head_strategy (M \<^bold>\<circ> N) # U"
                     proof -
                       have "Std U"
                         by (metis Std Std.simps(3) U list.exhaust_sel)
                       moreover have "\<not> Ide (\<Lambda>.head_strategy (M \<^bold>\<circ> N) # tl (u # U))"
                         using 1 4 \<Lambda>.ide_backward_stable by blast
                       ultimately show ?thesis
                         using ind4 ** 1 2 3 4 7 Std_implies_set_subset_elementary_reduction
                         by force
                     qed
                     show ?thesis
                     proof (intro conjI)
                       show "Std (stdz_insert (M \<^bold>\<circ> N) (u # U))"
                         using 6 8 by presburger
                       show "\<not> Ide ((M \<^bold>\<circ> N) # u # U) \<longrightarrow>
                                  stdz_insert (M \<^bold>\<circ> N) (u # U) \<^sup>*\<sim>\<^sup>* (M \<^bold>\<circ> N) # u # U"
                       proof
                         have "stdz_insert (M \<^bold>\<circ> N) (u # U) =
                               stdz_insert (\<Lambda>.head_strategy (M \<^bold>\<circ> N)) U"
                           using 6 by simp
                         also have "... \<^sup>*\<sim>\<^sup>* [\<Lambda>.head_strategy (M \<^bold>\<circ> N)] @ U"
                           using 8 by simp
                         also have "[\<Lambda>.head_strategy (M \<^bold>\<circ> N)] @ U \<^sup>*\<sim>\<^sup>* ([M \<^bold>\<circ> N] @ [u]) @ U"
                           by (meson A B U 7 Resid_Arr_self cong_append ide_char
                               prfx_transitive \<open>U \<noteq> [] \<Longrightarrow> Arr U\<close>)
                         also have "([M \<^bold>\<circ> N] @ [u]) @ U = (M \<^bold>\<circ> N) # u # U"
                           by simp
                         finally show "stdz_insert (M \<^bold>\<circ> N) (u # U) \<^sup>*\<sim>\<^sup>* (M \<^bold>\<circ> N) # u # U"
                           by blast
                       qed
                     qed
                   qed
                   next
                   assume 4: "\<not> \<Lambda>.Ide ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N))"
                   show ?thesis
                   proof (cases "U = []")
                     assume U: "U = []"
                     have 5: "stdz_insert (M \<^bold>\<circ> N) (u # U) =
                              \<Lambda>.head_strategy (M \<^bold>\<circ> N) #
                                standard_development ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N))"
                       using 1 2 3 4 U * ** \<open>\<Lambda>.is_App u \<or> \<Lambda>.is_Beta u\<close>
                       apply (cases u)
                          apply simp_all
                        apply blast
                       apply (cases M)
                           apply simp_all
                       by blast+
                     show ?thesis
                     proof (intro conjI)
                       show "Std (stdz_insert (M \<^bold>\<circ> N) (u # U))"
                       proof -
                         have "\<Lambda>.sseq (\<Lambda>.head_strategy (M \<^bold>\<circ> N))
                                      (hd (standard_development
                                             ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N))))"
                         proof -
                           have "\<Lambda>.seq (\<Lambda>.head_strategy (M \<^bold>\<circ> N))
                                       (hd (standard_development
                                              ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N))))"
                             using MN ** 4 \<Lambda>.Arr_head_strategy Arr_imp_arr_hd
                                   Ide_iff_standard_development_empty Src_hd_standard_development
                                   Std_imp_Arr Std_standard_development \<Lambda>.Arr_resid
                                   \<Lambda>.Src_head_strategy \<Lambda>.Src_resid
                             by force
                           moreover have "\<Lambda>.elementary_reduction
                                            (hd (standard_development
                                                  ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N))))"
                             by (metis 4 Ide_iff_standard_development_empty MN Std_consE
                                 Std_standard_development hd_Cons_tl \<Lambda>.Arr.simps(4)
-                                \<Lambda>.Arr_resid_ind \<Lambda>.Con_head_strategy
+                                \<Lambda>.Arr_resid \<Lambda>.Con_head_strategy
                                 \<Lambda>.sseq_imp_elementary_reduction1 Std.simps(2))
                           ultimately show ?thesis
                             using \<Lambda>.sseq_head_reductionI Std_standard_development
                             by (metis ** 2 3 Std U \<Lambda>.internal_reduction_preserves_no_head_redex
                                 \<Lambda>.is_internal_reduction_iff \<Lambda>.Src_head_strategy
                                 \<Lambda>.elementary_reduction_not_ide \<Lambda>.head_strategy_Src
                                 \<Lambda>.head_strategy_is_elementary \<Lambda>.ide_char \<Lambda>.is_head_reduction_char
                                 \<Lambda>.is_head_reduction_if \<Lambda>.seqE\<^sub>\<Lambda> Std.simps(2))
                         qed
                         thus ?thesis
                           by (metis 4 5 MN Ide_iff_standard_development_empty
-                              Std_standard_development \<Lambda>.Arr.simps(4) \<Lambda>.Arr_resid_ind
+                              Std_standard_development \<Lambda>.Arr.simps(4) \<Lambda>.Arr_resid
                               \<Lambda>.Con_head_strategy list.exhaust_sel Std.simps(3))
                       qed
                       show "\<not> Ide ((M \<^bold>\<circ> N) # u # U) \<longrightarrow>
                               stdz_insert (M \<^bold>\<circ> N) (u # U) \<^sup>*\<sim>\<^sup>* (M \<^bold>\<circ> N) # u # U"
                       proof
                         have "stdz_insert (M \<^bold>\<circ> N) (u # U) =
                               [\<Lambda>.head_strategy (M \<^bold>\<circ> N)] @
                                 standard_development ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N))"
                           using 5 by simp
                         also have "... \<^sup>*\<sim>\<^sup>* [\<Lambda>.head_strategy (M \<^bold>\<circ> N)] @
                                              [(M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N)]"
                         proof (intro cong_append)
                           show 6: "seq [\<Lambda>.head_strategy (M \<^bold>\<circ> N)]
                                        (standard_development
                                          ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N)))"
                             using 4 Ide_iff_standard_development_empty MN
                                   \<open>Std (stdz_insert (M \<^bold>\<circ> N) (u # U))\<close>
                                   arr_append_imp_seq arr_char calculation \<Lambda>.Arr_head_strategy
                                   \<Lambda>.Arr_resid lambda_calculus.Src_head_strategy
                             by force
                           show "[\<Lambda>.head_strategy (M \<^bold>\<circ> N)] \<^sup>*\<sim>\<^sup>* [\<Lambda>.head_strategy (M \<^bold>\<circ> N)]"
                             by (meson MN 6 cong_reflexive seqE)
                           show "standard_development ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N)) \<^sup>*\<sim>\<^sup>*
                                 [(M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N)]"
                             using 4 MN cong_standard_development \<Lambda>.Arr.simps(4)
-                                  \<Lambda>.Arr_resid_ind \<Lambda>.Con_head_strategy
+                                  \<Lambda>.Arr_resid \<Lambda>.Con_head_strategy
                             by presburger
                         qed
                         also have "[\<Lambda>.head_strategy (M \<^bold>\<circ> N)] @
                                      [(M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N)] \<^sup>*\<sim>\<^sup>*
                                    [M \<^bold>\<circ> N] @ [u]"
                           using B by blast
                         also have "[M \<^bold>\<circ> N] @ [u] = (M \<^bold>\<circ> N) # u # U"
                           using U by simp
                         finally show "stdz_insert (M \<^bold>\<circ> N) (u # U) \<^sup>*\<sim>\<^sup>* (M \<^bold>\<circ> N) # u # U"
                           by blast
                       qed
                     qed
                     next
                     assume U: "U \<noteq> []"
                     have 5: "stdz_insert (M \<^bold>\<circ> N) (u # U) =
                              \<Lambda>.head_strategy (M \<^bold>\<circ> N) #
                                stdz_insert (\<Lambda>.resid (M \<^bold>\<circ> N) (\<Lambda>.head_strategy (M \<^bold>\<circ> N))) U"
                       using 1 2 3 4 U * ** \<open>\<Lambda>.is_App u \<or> \<Lambda>.is_Beta u\<close>
                       apply (cases u)
                          apply simp_all
                        apply blast
                       apply (cases M)
                           apply simp_all
                       by blast+
                     have 6: "Std (stdz_insert ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N)) U) \<and>
                              set (stdz_insert ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N)) U)
                                \<subseteq> {a. \<Lambda>.elementary_reduction a} \<and>
                              stdz_insert ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N)) U \<^sup>*\<sim>\<^sup>*
                              (M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N) # U"
                     proof -
                       have "seq [(M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N)] U"
                       proof
                         show "Arr [(M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N)]"
-                          by (simp add: MN lambda_calculus.Arr_resid_ind \<Lambda>.Con_head_strategy)
+                          by (simp add: MN \<Lambda>.Arr_resid \<Lambda>.Con_head_strategy)
                         show "Arr U"
                           using U \<open>U \<noteq> [] \<Longrightarrow> Arr U\<close> by blast
                         show "\<Lambda>.Trg (last [(M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N)]) = \<Lambda>.Src (hd U)"
                           by (metis (mono_tags, lifting) B U Std Std_consE Trg_last_eqI
                               \<Lambda>.seq_char \<Lambda>.sseq_imp_seq last_ConsL last_snoc)
                       qed
                       thus ?thesis
                         using ind5 Std_implies_set_subset_elementary_reduction
                         by (metis ** 1 2 3 4 Std Std.simps(3) Arr_iff_Con_self Ide.simps(3)
                             Resid.simps(1) seq_char \<Lambda>.ide_char list.exhaust_sel list.sel(1,3))
                     qed
                     show ?thesis
                     proof (intro conjI)
                       show "Std (stdz_insert (M \<^bold>\<circ> N) (u # U))"
                       proof -
                         have "\<Lambda>.sseq (\<Lambda>.head_strategy (M \<^bold>\<circ> N))
                                    (hd (stdz_insert ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N)) U))"
                         proof -
                           have "\<Lambda>.seq (\<Lambda>.head_strategy (M \<^bold>\<circ> N))
                                       (hd (stdz_insert ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N)) U))"
                           proof
                             show "\<Lambda>.Arr (\<Lambda>.head_strategy (M \<^bold>\<circ> N))"
                               using MN \<Lambda>.Arr_head_strategy by force
                             show "\<Lambda>.Arr (hd (stdz_insert ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N)) U))"
                               using 6
                               by (metis Ide.simps(1) Resid.simps(2) Std_consE hd_Cons_tl ide_char)
                             show "\<Lambda>.Trg (\<Lambda>.head_strategy (M \<^bold>\<circ> N)) =
                                   \<Lambda>.Src (hd (stdz_insert ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N)) U))"
                               using 6
                               by (metis MN Src_hd_eqI \<Lambda>.Arr.simps(4) \<Lambda>.Con_head_strategy
                                   \<Lambda>.Src_resid list.sel(1))
                           qed
                           moreover have "\<Lambda>.is_head_reduction (\<Lambda>.head_strategy (M \<^bold>\<circ> N))"
                             using ** 1 2 3 \<Lambda>.Src_head_strategy \<Lambda>.head_strategy_is_elementary
                                   \<Lambda>.head_strategy_Src \<Lambda>.is_head_reduction_char \<Lambda>.seq_char
                             by (metis \<Lambda>.Src_head_redex \<Lambda>.contains_head_reduction_iff
                                 \<Lambda>.head_redex_is_head_reduction
                                 \<Lambda>.internal_reduction_preserves_no_head_redex
                                 \<Lambda>.is_internal_reduction_iff)
                           moreover have "\<Lambda>.elementary_reduction
                                           (hd (stdz_insert ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N)) U))"
                             by (metis 6 Ide.simps(1) Resid.simps(2) ide_char hd_in_set
                                 in_mono mem_Collect_eq)
                           ultimately show ?thesis
                             using \<Lambda>.sseq_head_reductionI by blast
                         qed
                         thus ?thesis
                           by (metis 5 6 Std.simps(3) Arr.simps(1) Con_implies_Arr(1)
                               con_char prfx_implies_con list.exhaust_sel)
                       qed
                       show "\<not> Ide ((M \<^bold>\<circ> N) # u # U) \<longrightarrow>
                                 stdz_insert (M \<^bold>\<circ> N) (u # U) \<^sup>*\<sim>\<^sup>* (M \<^bold>\<circ> N) # u # U"
                       proof
                         have "stdz_insert (M \<^bold>\<circ> N) (u # U) =
                               [\<Lambda>.head_strategy (M \<^bold>\<circ> N)] @
                                 stdz_insert ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N)) U"
                           using 5 by simp
                         also have 10: "... \<^sup>*\<sim>\<^sup>* [\<Lambda>.head_strategy (M \<^bold>\<circ> N)] @
                                                  ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N) # U)"
                         proof (intro cong_append)
                           show 10: "seq [\<Lambda>.head_strategy (M \<^bold>\<circ> N)]
                                         (stdz_insert ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N)) U)"
                             by (metis 5 6 Ide.simps(1) Resid.simps(1) Std_imp_Arr
                                 \<open>Std (stdz_insert (M \<^bold>\<circ> N) (u # U))\<close> arr_append_imp_seq
                                 arr_char calculation ide_char list.distinct(1))
                           show "[\<Lambda>.head_strategy (M \<^bold>\<circ> N)] \<^sup>*\<sim>\<^sup>* [\<Lambda>.head_strategy (M \<^bold>\<circ> N)]"
                             using MN 10 cong_reflexive by blast
                           show "stdz_insert ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N)) U \<^sup>*\<sim>\<^sup>*
                                 (M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N) # U"
                             using 6 by auto
                         qed
                         also have 11: "[\<Lambda>.head_strategy (M \<^bold>\<circ> N)] @
                                          ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N) # U) =
                                        ([\<Lambda>.head_strategy (M \<^bold>\<circ> N)] @
                                          [(M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N)]) @ U"
                           by simp
                         also have "... \<^sup>*\<sim>\<^sup>* (([M \<^bold>\<circ> N] @ [u]) @ U)"
                         proof -
                           have "seq ([\<Lambda>.head_strategy (M \<^bold>\<circ> N)] @
                                        [(M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N)]) U"
                             by (metis U 10 11 append_is_Nil_conv arr_append_imp_seq
                                 cong_implies_coterminal coterminalE not_Cons_self2)
                           thus ?thesis
                             using B cong_append cong_reflexive by blast
                         qed
                         also have "([M \<^bold>\<circ> N] @ [u]) @ U = (M \<^bold>\<circ> N) # u # U"
                           by simp
                         finally show "stdz_insert (M \<^bold>\<circ> N) (u # U) \<^sup>*\<sim>\<^sup>* (M \<^bold>\<circ> N) # u # U"
                           by blast
                       qed
                     qed
                   qed
                 qed
                 next
                 assume 3: "\<not> \<Lambda>.contains_head_reduction u"
                 have u: "\<Lambda>.Arr u \<and> \<Lambda>.is_App u \<and> \<not> \<Lambda>.contains_head_reduction u"
                   using "3" \<open>\<Lambda>.is_App u \<or> \<Lambda>.is_Beta u\<close> \<Lambda>.is_Beta_def u by force
                 have 5: "\<not> \<Lambda>.Ide u"
                   by (metis Std Std.simps(2) Std.simps(3) \<Lambda>.elementary_reduction_not_ide
                       \<Lambda>.ide_char neq_Nil_conv \<Lambda>.sseq_imp_elementary_reduction1)
                 show ?thesis
                 proof -
                   have 4: "stdz_insert (M \<^bold>\<circ> N) (u # U) =
                            map (\<lambda>X. \<Lambda>.App X (\<Lambda>.Src N))
                                (stdz_insert M (filter notIde (map \<Lambda>.un_App1 (u # U)))) @
                            map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
                                (stdz_insert N (filter notIde (map \<Lambda>.un_App2 (u # U))))"
                     using MN 1 2 3 5 * ** \<open>\<Lambda>.is_App u \<or> \<Lambda>.is_Beta u\<close>
                     apply (cases "U = []"; cases M; cases u)
                                         apply simp_all
                     by blast+
                   have ***: "set U \<subseteq> Collect \<Lambda>.is_App"
                     using u 5 Std seq_App_Std_implies by blast
                   have X: "Std (filter notIde (map \<Lambda>.un_App1 (u # U)))"
                     by (metis *** Std Std_filter_map_un_App1 insert_subset list.simps(15)
                         mem_Collect_eq u)
                   have Y: "Std (filter notIde (map \<Lambda>.un_App2 (u # U)))"
                     by (metis *** u Std Std_filter_map_un_App2 insert_subset list.simps(15)
                         mem_Collect_eq)
                   have A: "\<not> \<Lambda>.un_App1 ` set (u # U) \<subseteq> Collect \<Lambda>.Ide \<Longrightarrow>
                              Std (stdz_insert M (filter notIde (map \<Lambda>.un_App1 (u # U)))) \<and>
                              set (stdz_insert M (filter notIde (map \<Lambda>.un_App1 (u # U))))
                                 \<subseteq> {a. \<Lambda>.elementary_reduction a} \<and>
                              stdz_insert M (filter notIde (map \<Lambda>.un_App1 (u # U))) \<^sup>*\<sim>\<^sup>*
                              M # filter notIde (map \<Lambda>.un_App1 (u # U))"
                   proof -
                     assume *: "\<not> \<Lambda>.un_App1 ` set (u # U) \<subseteq> Collect \<Lambda>.Ide"
                     have "seq [M] (filter notIde (map \<Lambda>.un_App1 (u # U)))"
                     proof
                       show "Arr [M]"
                         using MN by simp
                       show "Arr (filter notIde (map \<Lambda>.un_App1 (u # U)))"
                         by (metis (mono_tags, lifting) "*" Std_imp_Arr X empty_filter_conv
                             list.set_map mem_Collect_eq subset_code(1))
                       show "\<Lambda>.Trg (last [M]) = \<Lambda>.Src (hd (filter notIde (map \<Lambda>.un_App1 (u # U))))"
                       proof -
                         have "\<Lambda>.Trg (last [M]) = \<Lambda>.Src (hd (map \<Lambda>.un_App1 (u # U)))"
                           using ** u by fastforce
                         also have "... = \<Lambda>.Src (hd (filter notIde (map \<Lambda>.un_App1 (u # U))))"
                         proof -
                           have "Arr (map \<Lambda>.un_App1 (u # U))"
                             using u ***
                             by (metis Arr_map_un_App1 Std Std_imp_Arr insert_subset
                                 list.simps(15) mem_Collect_eq neq_Nil_conv)
                           moreover have "\<not> Ide (map \<Lambda>.un_App1 (u # U))"
                             by (metis "*" Collect_cong \<Lambda>.ide_char list.set_map set_Ide_subset_ide)
                           ultimately show ?thesis
                             using Src_hd_eqI cong_filter_notIde by blast
                         qed
                         finally show ?thesis by blast
                       qed
                     qed
                     moreover have "\<not> Ide (M # filter notIde (map \<Lambda>.un_App1 (u # U)))"
                       using *
                       by (metis (no_types, lifting) *** Arr_map_un_App1 Std Std_imp_Arr
                           Arr.simps(1) Ide.elims(2) Resid_Arr_Ide_ind ide_char
                           seq_char calculation(1) cong_filter_notIde filter_notIde_Ide
                           insert_subset list.discI list.sel(3) list.simps(15) mem_Collect_eq u)
                     ultimately show ?thesis
                       by (metis X 1 2 3 ** ind7 Std_implies_set_subset_elementary_reduction
                           list.sel(1))
                   qed
                   have B: "\<not> \<Lambda>.un_App2 ` set (u # U) \<subseteq> Collect \<Lambda>.Ide \<Longrightarrow>
                              Std (stdz_insert N (filter notIde (map \<Lambda>.un_App2 (u # U)))) \<and>
                              set (stdz_insert N (filter notIde (map \<Lambda>.un_App2 (u # U))))
                                 \<subseteq> {a. \<Lambda>.elementary_reduction a} \<and>
                              stdz_insert N (filter notIde (map \<Lambda>.un_App2 (u # U))) \<^sup>*\<sim>\<^sup>*
                              N # filter notIde (map \<Lambda>.un_App2 (u # U))"
                   proof -
                     assume **: "\<not> \<Lambda>.un_App2 ` set (u # U) \<subseteq> Collect \<Lambda>.Ide"
                     have "seq [N] (filter notIde (map \<Lambda>.un_App2 (u # U)))"
                     proof
                       show "Arr [N]"
                         using MN by simp
                       show "Arr (filter (\<lambda>u. \<not> \<Lambda>.Ide u) (map \<Lambda>.un_App2 (u # U)))"
                         by (metis (mono_tags, lifting) ** Std_imp_Arr Y empty_filter_conv
                             list.set_map mem_Collect_eq subset_code(1))
                       show "\<Lambda>.Trg (last [N]) = \<Lambda>.Src (hd (filter notIde (map \<Lambda>.un_App2 (u # U))))"
                       proof -
                         have "\<Lambda>.Trg (last [N]) = \<Lambda>.Src (hd (map \<Lambda>.un_App2 (u # U)))"
                           by (metis u seq Trg_last_Src_hd_eqI \<Lambda>.Src.simps(4)
                               \<Lambda>.Trg.simps(3) \<Lambda>.is_App_def \<Lambda>.lambda.sel(4) last_ConsL
                               list.discI list.map_sel(1) list.sel(1))
                         also have "... = \<Lambda>.Src (hd (filter notIde (map \<Lambda>.un_App2 (u # U))))"
                         proof -
                           have "Arr (map \<Lambda>.un_App2 (u # U))"
                             using u ***
                             by (metis Arr_map_un_App2 Std Std_imp_Arr list.distinct(1)
                                 mem_Collect_eq set_ConsD subset_code(1))
                           moreover have "\<not> Ide (map \<Lambda>.un_App2 (u # U))"
                             by (metis ** Collect_cong \<Lambda>.ide_char list.set_map set_Ide_subset_ide)
                           ultimately show ?thesis
                             using Src_hd_eqI cong_filter_notIde by blast
                         qed
                         finally show ?thesis by blast
                       qed
                     qed 
                     moreover have "\<Lambda>.seq (M \<^bold>\<circ> N) u"
                       by (metis u Srcs_simp\<^sub>\<Lambda>\<^sub>P Arr.simps(2) Trgs.simps(2) seq_char \<Lambda>.arr_char
                           list.sel(1) seq \<Lambda>.seqI \<Lambda>.sources_char\<^sub>\<Lambda>)
                     moreover have "\<not> Ide (N # filter notIde (map \<Lambda>.un_App2 (u # U)))"
                       using u *
                       by (metis (no_types, lifting) *** Arr_map_un_App2 Std Std_imp_Arr
                           Arr.simps(1) Ide.elims(2) Resid_Arr_Ide_ind ide_char
                           seq_char calculation(1) cong_filter_notIde filter_notIde_Ide
                           insert_subset list.discI list.sel(3) list.simps(15) mem_Collect_eq)
                     ultimately show ?thesis
                       using * 1 2 3 Y ind8 Std_implies_set_subset_elementary_reduction
                       by simp
                   qed
                   show ?thesis
                   proof (cases "\<Lambda>.un_App1 ` set (u # U) \<subseteq> Collect \<Lambda>.Ide";
                          cases "\<Lambda>.un_App2 ` set (u # U) \<subseteq> Collect \<Lambda>.Ide")
                     show "\<lbrakk>\<Lambda>.un_App1 ` set (u # U) \<subseteq> Collect \<Lambda>.Ide;
                            \<Lambda>.un_App2 ` set (u # U) \<subseteq> Collect \<Lambda>.Ide\<rbrakk>
                              \<Longrightarrow> ?thesis"
                     proof -
                       assume *: "\<Lambda>.un_App1 ` set (u # U) \<subseteq> Collect \<Lambda>.Ide"
                       assume **: "\<Lambda>.un_App2 ` set (u # U) \<subseteq> Collect \<Lambda>.Ide"
                       have False
                         using u 5 * ** Ide_iff_standard_development_empty
                         by (metis \<Lambda>.Ide.simps(4) image_subset_iff \<Lambda>.lambda.collapse(3)
                             list.set_intros(1) mem_Collect_eq)
                       thus ?thesis by blast
                     qed
                     show "\<lbrakk>\<Lambda>.un_App1 ` set (u # U) \<subseteq> Collect \<Lambda>.Ide;
                            \<not> \<Lambda>.un_App2 ` set (u # U) \<subseteq> Collect \<Lambda>.Ide\<rbrakk>
                              \<Longrightarrow> ?thesis"
                     proof -
                       assume *: "\<Lambda>.un_App1 ` set (u # U) \<subseteq> Collect \<Lambda>.Ide"
                       assume **: "\<not> \<Lambda>.un_App2 ` set (u # U) \<subseteq> Collect \<Lambda>.Ide"
                       have 6: "\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))) = \<Lambda>.Trg M"
                       proof -
                         have "\<Lambda>.Trg M = \<Lambda>.Src (hd (map \<Lambda>.un_App1 (u # U)))"
                           by (metis u seq Trg_last_Src_hd_eqI hd_map \<Lambda>.Src.simps(4) \<Lambda>.Trg.simps(3)
                               \<Lambda>.is_App_def \<Lambda>.lambda.sel(3) last_ConsL list.discI list.sel(1))
                         also have "... = \<Lambda>.Trg (last (map \<Lambda>.un_App1 (u # U)))"
                         proof -
                           have 6: "Ide (map \<Lambda>.un_App1 (u # U))"
                             using * *** u Std Std_imp_Arr Ide_char ide_char Arr_map_un_App1
                             by (metis (mono_tags, lifting) Collect_cong insert_subset
                                 \<Lambda>.ide_char list.distinct(1) list.set_map list.simps(15)
                                 mem_Collect_eq)
                           hence "Src (map \<Lambda>.un_App1 (u # U)) = Trg (map \<Lambda>.un_App1 (u # U))"
                             using Ide_imp_Src_eq_Trg by blast
                           thus ?thesis
                             using 6 Ide_implies_Arr by force
                         qed
                         also have "... = \<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))"
                           by (simp add: last_map)
                         finally show ?thesis by simp
                       qed
                       have "filter notIde (map \<Lambda>.un_App1 (u # U)) = []"
                         using * by (simp add: subset_eq)
                       hence 4: "stdz_insert (M \<^bold>\<circ> N) (u # U) =
                                 map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N) (standard_development M) @
                                 map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
                                     (stdz_insert N (filter notIde (map \<Lambda>.un_App2 (u # U))))"
                         using u 4 5 * ** Ide_iff_standard_development_empty MN
                         by simp
                       show ?thesis
                       proof (intro conjI)
                         have "Std (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N) (standard_development M) @
                                    map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
                                        (stdz_insert N (filter notIde (map \<Lambda>.un_App2 (u # U)))))"
                         proof (intro Std_append)
                           show "Std (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N) (standard_development M))"
                             using Std_map_App1 Std_standard_development MN \<Lambda>.Ide_Src
                             by force
                           show "Std (map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
                                          (stdz_insert N (filter notIde (map \<Lambda>.un_App2 (u # U)))))"
                             using "**" B MN 6 Std_map_App2 \<Lambda>.Ide_Trg by presburger
                           show "map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N) (standard_development M) = [] \<or>
                                 map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
                                     (stdz_insert N (filter notIde (map \<Lambda>.un_App2 (u # U)))) = [] \<or>
                                 \<Lambda>.sseq (last (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N) (standard_development M)))
                                        (hd (map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
                                                 (stdz_insert N (filter notIde
                                                                (map \<Lambda>.un_App2 (u # U))))))"
                           proof (cases "\<Lambda>.Ide M")
                             show "\<Lambda>.Ide M \<Longrightarrow> ?thesis"
                               using Ide_iff_standard_development_empty MN by blast
                             assume M: "\<not> \<Lambda>.Ide M"
                             have "\<Lambda>.sseq (last (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N) (standard_development M)))
                                          (hd (map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
                                                   (stdz_insert N (filter notIde
                                                                  (map \<Lambda>.un_App2 (u # U))))))"
                             proof -
                               have "last (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N) (standard_development M)) =
                                     \<Lambda>.App (last (standard_development M)) (\<Lambda>.Src N)"
                                 using M
                                 by (simp add: Ide_iff_standard_development_empty MN last_map)
                               moreover have "hd (map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
                                                      (stdz_insert N (filter notIde
                                                                     (map \<Lambda>.un_App2 (u # U))))) =
                                              \<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))))
                                                    (hd (stdz_insert N (filter notIde
                                                                       (map \<Lambda>.un_App2 (u # U)))))"
                                 by (metis ** B Ide.simps(1) Resid.simps(2) hd_map ide_char)
                               moreover
                               have "\<Lambda>.sseq (\<Lambda>.App (last (standard_development M)) (\<Lambda>.Src N))
                                             ..."
                               proof -
                                 have "\<Lambda>.elementary_reduction (last (standard_development M))"
                                   using M MN Std_standard_development
                                         Ide_iff_standard_development_empty last_in_set
                                         mem_Collect_eq set_standard_development subsetD
                                   by metis
                                 moreover have "\<Lambda>.elementary_reduction
                                                  (hd (stdz_insert N
                                                         (filter notIde (map \<Lambda>.un_App2 (u # U)))))"
                                   using ** B
                                   by (metis Arr.simps(1) Con_implies_Arr(2) Ide.simps(1)
                                       ide_char in_mono list.set_sel(1) mem_Collect_eq)
                                 moreover have "\<Lambda>.Trg (last (standard_development M)) =
                                                \<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))"
                                   using M MN 6 Trg_last_standard_development by presburger
                                 moreover have "\<Lambda>.Src N =
                                                \<Lambda>.Src (hd (stdz_insert N
                                                             (filter notIde (map \<Lambda>.un_App2 (u # U)))))"
                                   by (metis "**" B Src_hd_eqI list.sel(1))
                                 ultimately show ?thesis
                                   by simp
                               qed
                               ultimately show ?thesis by simp
                             qed
                             thus ?thesis by blast
                           qed
                         qed
                         thus "Std (stdz_insert (M \<^bold>\<circ> N) (u # U))"
                           using 4 by simp
                         show "\<not> Ide ((M \<^bold>\<circ> N) # u # U) \<longrightarrow>
                                   stdz_insert (M \<^bold>\<circ> N) (u # U) \<^sup>*\<sim>\<^sup>* (M \<^bold>\<circ> N) # u # U"
                         proof
                           show "stdz_insert (M \<^bold>\<circ> N) (u # U) \<^sup>*\<sim>\<^sup>* (M \<^bold>\<circ> N) # u # U"
                           proof (cases "\<Lambda>.Ide M")
                             assume M: "\<Lambda>.Ide M"
                             have "stdz_insert (M \<^bold>\<circ> N) (u # U) =
                                   map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
                                       (stdz_insert N (filter notIde (map \<Lambda>.un_App2 (u # U))))"
                               using 4 M MN Ide_iff_standard_development_empty by simp
                             also have "... \<^sup>*\<sim>\<^sup>* (map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
                                                     (N # filter notIde (map \<Lambda>.un_App2 (u # U))))"
                             proof -
                               have "\<Lambda>.Ide (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))))"
                                 using M 6 \<Lambda>.Ide_Trg \<Lambda>.Ide_implies_Arr by fastforce
                               thus ?thesis
                                 using ** *** B u cong_map_App1 by blast
                             qed
                             also have "map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
                                            (N # filter notIde (map \<Lambda>.un_App2 (u # U))) =
                                        map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
                                            (filter notIde (N # map \<Lambda>.un_App2 (u # U)))"
                               using 1 M by force
                             also have "map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
                                            (filter notIde (N # map \<Lambda>.un_App2 (u # U))) \<^sup>*\<sim>\<^sup>*
                                        map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
                                            (N # map \<Lambda>.un_App2 (u # U))"
                             proof -
                               have "Arr (N # map \<Lambda>.un_App2 (u # U))"
                               proof
                                 show "\<Lambda>.arr N"
                                   using MN by blast
                                 show "Arr (map \<Lambda>.un_App2 (u # U))"
                                   using *** u Std Arr_map_un_App2
                                   by (metis Std_imp_Arr insert_subset list.distinct(1)
                                       list.simps(15) mem_Collect_eq)
                                 show "\<Lambda>.trg N = Src (map \<Lambda>.un_App2 (u # U))"
                                   using u \<open>\<Lambda>.seq (M \<^bold>\<circ> N) u\<close> \<Lambda>.seq_char \<Lambda>.is_App_def by auto
                               qed
                               moreover have "\<not> Ide (N # map \<Lambda>.un_App2 (u # U))"
                                 using 1 M by force
                               moreover have "\<Lambda>.Ide (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))))"
                                 using M 6 \<Lambda>.Ide_Trg \<Lambda>.Ide_implies_Arr by presburger
                               ultimately show ?thesis
                                 using cong_filter_notIde cong_map_App1 by blast
                             qed
                             also have "map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
                                            (N # map \<Lambda>.un_App2 (u # U)) =
                                        map (\<Lambda>.App M) (N # map \<Lambda>.un_App2 (u # U))"
                               using M MN \<open>\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))) = \<Lambda>.Trg M\<close>
                                     \<Lambda>.Ide_iff_Trg_self
                               by force
                             also have "... = (M \<^bold>\<circ> N) # map (\<Lambda>.App M) (map \<Lambda>.un_App2 (u # U))"
                               by simp
                             also have "... = (M \<^bold>\<circ> N) # u # U"
                             proof -
                               have "Arr (u # U)"
                                 using Std Std_imp_Arr by blast
                               moreover have "set (u # U) \<subseteq> Collect \<Lambda>.is_App"
                                 using *** u by simp
                               moreover have "\<Lambda>.un_App1 u = M"
                                 by (metis * u M seq Trg_last_Src_hd_eqI \<Lambda>.Ide_iff_Src_self
                                     \<Lambda>.Ide_iff_Trg_self \<Lambda>.Ide_implies_Arr \<Lambda>.Src.simps(4)
                                     \<Lambda>.Trg.simps(3) \<Lambda>.lambda.collapse(3) \<Lambda>.lambda.sel(3)
                                     last.simps list.distinct(1) list.sel(1) list.set_intros(1)
                                     list.set_map list.simps(9) mem_Collect_eq standardize.cases
                                     subset_iff)
                               moreover have "\<Lambda>.un_App1 ` set (u # U) \<subseteq> {M}"
                               proof -
                                 have "Ide (map \<Lambda>.un_App1 (u # U))"
                                   using * *** Std Std_imp_Arr Arr_map_un_App1
                                   by (metis Collect_cong Ide_char calculation(1-2) \<Lambda>.ide_char
                                       list.set_map)
                                 thus ?thesis
                                   by (metis calculation(3) hd_map list.discI list.sel(1)
                                       list.set_map set_Ide_subset_single_hd)
                               qed
                               ultimately show ?thesis
                                 using M map_App_map_un_App2 by blast
                             qed
                             finally show ?thesis by blast
                             next
                             assume M: "\<not> \<Lambda>.Ide M"
                             have "stdz_insert (M \<^bold>\<circ> N) (u # U) =
                                   map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N) (standard_development M) @
                                   map (\<lambda>X. \<Lambda>.Trg M \<^bold>\<circ> X)
                                       (stdz_insert N (filter notIde (map \<Lambda>.un_App2 (u # U))))"
                               using 4 6 by simp
                             also have "... \<^sup>*\<sim>\<^sup>* [M \<^bold>\<circ> \<Lambda>.Src N] @ [\<Lambda>.Trg M \<^bold>\<circ> N] @
                                                  map (\<lambda>X. \<Lambda>.Trg M \<^bold>\<circ> X)
                                                      (filter notIde (map \<Lambda>.un_App2 (u # U)))"
                             proof (intro cong_append)
                               show "map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N) (standard_development M) \<^sup>*\<sim>\<^sup>*
                                     [M \<^bold>\<circ> \<Lambda>.Src N]"
                                 using MN M cong_standard_development \<Lambda>.Ide_Src
                                       cong_map_App2 [of "\<Lambda>.Src N" "standard_development M" "[M]"]
                                 by simp
                               show "map (\<lambda>X. \<Lambda>.Trg M \<^bold>\<circ> X)
                                         (stdz_insert N (filter notIde (map \<Lambda>.un_App2 (u # U)))) \<^sup>*\<sim>\<^sup>*
                                     [\<Lambda>.Trg M \<^bold>\<circ> N] @
                                       map (\<lambda>X. \<Lambda>.Trg M \<^bold>\<circ> X)
                                           (filter notIde (map \<Lambda>.un_App2 (u # U)))"
                               proof -
                                 have "map (\<lambda>X. \<Lambda>.Trg M \<^bold>\<circ> X)
                                           (stdz_insert N (filter notIde (map \<Lambda>.un_App2 (u # U)))) \<^sup>*\<sim>\<^sup>*
                                       map (\<lambda>X. \<Lambda>.Trg M \<^bold>\<circ> X)
                                           (N # filter notIde (map \<Lambda>.un_App2 (u # U)))"
                                   using ** B MN cong_map_App1 lambda_calculus.Ide_Trg
                                   by presburger
                                 also have "map (\<lambda>X. \<Lambda>.Trg M \<^bold>\<circ> X)
                                                (N # filter notIde (map \<Lambda>.un_App2 (u # U))) =
                                            [\<Lambda>.Trg M \<^bold>\<circ> N] @
                                              map (\<lambda>X. \<Lambda>.Trg M \<^bold>\<circ> X)
                                                  (filter notIde (map \<Lambda>.un_App2 (u # U)))"
                                   by simp
                                 finally show ?thesis by blast
                               qed
                               show "seq (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N) (standard_development M))
                                         (map (\<lambda>X. \<Lambda>.Trg M \<^bold>\<circ> X)
                                              (stdz_insert N (filter notIde
                                                                     (map \<Lambda>.un_App2 (u # U)))))"
                                 using MN M ** B cong_standard_development [of M]
                                 by (metis Nil_is_append_conv Resid.simps(2) Std_imp_Arr
                                     \<open>Std (stdz_insert (M \<^bold>\<circ> N) (u # U))\<close> arr_append_imp_seq
                                     arr_char calculation complete_development_Ide_iff
                                     complete_development_def list.map_disc_iff development.simps(1))
                             qed
                             also have "[M \<^bold>\<circ> \<Lambda>.Src N] @ [\<Lambda>.Trg M \<^bold>\<circ> N] @
                                           map (\<lambda>X. \<Lambda>.Trg M \<^bold>\<circ> X)
                                               (filter notIde (map \<Lambda>.un_App2 (u # U))) =
                                        ([M \<^bold>\<circ> \<Lambda>.Src N] @ [\<Lambda>.Trg M \<^bold>\<circ> N]) @
                                          map (\<lambda>X. \<Lambda>.Trg M \<^bold>\<circ> X)
                                              (filter notIde (map \<Lambda>.un_App2 (u # U)))"
                               by simp
                             also have "([M \<^bold>\<circ> \<Lambda>.Src N] @ [\<Lambda>.Trg M \<^bold>\<circ> N]) @
                                           map (\<lambda>X. \<Lambda>.Trg M \<^bold>\<circ> X)
                                               (filter notIde (map \<Lambda>.un_App2 (u # U))) \<^sup>*\<sim>\<^sup>*
                                         ([M \<^bold>\<circ> \<Lambda>.Src N] @ [\<Lambda>.Trg M \<^bold>\<circ> N]) @
                                            map (\<lambda>X. \<Lambda>.Trg M \<^bold>\<circ> X) (map \<Lambda>.un_App2 (u # U))"
                             proof (intro cong_append)
                               show "seq ([M \<^bold>\<circ> \<Lambda>.Src N] @ [\<Lambda>.Trg M \<^bold>\<circ> N])
                                         (map (\<lambda>X. \<Lambda>.Trg M \<^bold>\<circ> X)
                                              (filter notIde (map \<Lambda>.un_App2 (u # U))))"
                               proof
                                 show "Arr ([M \<^bold>\<circ> \<Lambda>.Src N] @ [\<Lambda>.Trg M \<^bold>\<circ> N])"
                                   by (simp add: MN)
                                 show 9: "Arr (map (\<lambda>X. \<Lambda>.Trg M \<^bold>\<circ> X)
                                              (filter notIde (map \<Lambda>.un_App2 (u # U))))"
                                 proof -
                                   have "Arr (map \<Lambda>.un_App2 (u # U))"
                                     using *** u Arr_map_un_App2
                                     by (metis Std Std_imp_Arr list.distinct(1) mem_Collect_eq
                                         set_ConsD subset_code(1))
                                   moreover have "\<not> Ide (map \<Lambda>.un_App2 (u # U))"
                                     using **
                                     by (metis Collect_cong \<Lambda>.ide_char list.set_map
                                         set_Ide_subset_ide)
                                   ultimately show ?thesis
                                     using cong_filter_notIde
                                     by (metis Arr_map_App2 Con_implies_Arr(2) Ide.simps(1)
                                         MN ide_char \<Lambda>.Ide_Trg)
                                 qed
                                 show "\<Lambda>.Trg (last ([M \<^bold>\<circ> \<Lambda>.Src N] @ [\<Lambda>.Trg M \<^bold>\<circ> N])) =
                                       \<Lambda>.Src (hd (map (\<lambda>X. \<Lambda>.Trg M \<^bold>\<circ> X)
                                             (filter notIde (map \<Lambda>.un_App2 (u # U)))))"
                                 proof -
                                   have "\<Lambda>.Trg (last ([M \<^bold>\<circ> \<Lambda>.Src N] @ [\<Lambda>.Trg M \<^bold>\<circ> N])) =
                                         \<Lambda>.Trg M \<^bold>\<circ> \<Lambda>.Trg N"
                                     using MN by auto
                                   also have "... = \<Lambda>.Src u"
                                     using Trg_last_Src_hd_eqI seq by force
                                   also have "... = \<Lambda>.Src (\<Lambda>.Trg M \<^bold>\<circ> \<Lambda>.un_App2 u)"
                                     using MN \<open>\<Lambda>.App (\<Lambda>.Trg M) (\<Lambda>.Trg N) = \<Lambda>.Src u\<close> u by auto
                                   also have 8: "... = \<Lambda>.Trg M \<^bold>\<circ> \<Lambda>.Src (\<Lambda>.un_App2 u)"
                                     using MN by simp
                                   also have 7: "... = \<Lambda>.Trg M \<^bold>\<circ> 
                                                           \<Lambda>.Src (hd (filter notIde
                                                                        (map \<Lambda>.un_App2 (u # U))))"
                                     using u 5 list.simps(9) cong_filter_notIde
                                           \<open>filter notIde (map \<Lambda>.un_App1 (u # U)) = []\<close>
                                     by auto
                                   also have "... = \<Lambda>.Src (hd (map (\<lambda>X. \<Lambda>.Trg M \<^bold>\<circ> X)
                                                              (filter notIde
                                                                 (map \<Lambda>.un_App2 (u # U)))))"
                                     (* TODO: Figure out what is going on with 7 8 9. *)
                                     by (metis 7 8 9 Arr.simps(1) hd_map \<Lambda>.Src.simps(4)
                                         \<Lambda>.lambda.sel(4) list.simps(8))
                                   finally show "\<Lambda>.Trg (last ([M \<^bold>\<circ> \<Lambda>.Src N] @ [\<Lambda>.Trg M \<^bold>\<circ> N])) =
                                                 \<Lambda>.Src (hd (map (\<lambda>X. \<Lambda>.Trg M \<^bold>\<circ> X)
                                                              (filter notIde
                                                                      (map \<Lambda>.un_App2 (u # U)))))"
                                     by blast
                                 qed
                               qed
                               show "seq [M \<^bold>\<circ> \<Lambda>.Src N] [\<Lambda>.Trg M \<^bold>\<circ> N]"
                                 using MN by fastforce
                               show "[M \<^bold>\<circ> \<Lambda>.Src N] \<^sup>*\<sim>\<^sup>* [M \<^bold>\<circ> \<Lambda>.Src N]"
                                 using MN
                                 by (meson head_redex_decomp \<Lambda>.Arr.simps(4) \<Lambda>.Arr_Src
                                     prfx_transitive)
                               show "[\<Lambda>.Trg M \<^bold>\<circ> N] \<^sup>*\<sim>\<^sup>* [\<Lambda>.Trg M \<^bold>\<circ> N]"
                                 using MN
                                 by (meson \<open>seq [M \<^bold>\<circ> \<Lambda>.Src N] [\<Lambda>.Trg M \<^bold>\<circ> N]\<close> cong_reflexive seqE)
                               show "map (\<lambda>X. \<Lambda>.Trg M \<^bold>\<circ> X)
                                         (filter notIde (map \<Lambda>.un_App2 (u # U))) \<^sup>*\<sim>\<^sup>*
                                     map (\<lambda>X. \<Lambda>.Trg M \<^bold>\<circ> X) (map \<Lambda>.un_App2 (u # U))"
                               proof -
                                 have "Arr (map \<Lambda>.un_App2 (u # U))"
                                   using *** u Arr_map_un_App2
                                   by (metis Std Std_imp_Arr list.distinct(1) mem_Collect_eq
                                       set_ConsD subset_code(1))
                                 moreover have "\<not> Ide (map \<Lambda>.un_App2 (u # U))"
                                   using **
                                   by (metis Collect_cong \<Lambda>.ide_char list.set_map
                                       set_Ide_subset_ide)
                                 ultimately show ?thesis
                                   using M MN cong_filter_notIde cong_map_App1 \<Lambda>.Ide_Trg
                                   by presburger
                               qed
                             qed
                             also have "([M \<^bold>\<circ> \<Lambda>.Src N] @ [\<Lambda>.Trg M \<^bold>\<circ> N]) @
                                           map (\<lambda>X. \<Lambda>.Trg M \<^bold>\<circ> X) (map \<Lambda>.un_App2 (u # U)) \<^sup>*\<sim>\<^sup>*
                                        [M \<^bold>\<circ> N] @ u # U"
                             proof (intro cong_append)
                               show "seq ([M \<^bold>\<circ> \<Lambda>.Src N] @ [\<Lambda>.Trg M \<^bold>\<circ> N])
                                         (map (\<lambda>X. \<Lambda>.Trg M \<^bold>\<circ> X) (map \<Lambda>.un_App2 (u # U)))"
                                 by (metis Nil_is_append_conv Nil_is_map_conv arr_append_imp_seq
                                     calculation cong_implies_coterminal coterminalE
                                     list.distinct(1))
                               show "[M \<^bold>\<circ> \<Lambda>.Src N] @ [\<Lambda>.Trg M \<^bold>\<circ> N] \<^sup>*\<sim>\<^sup>* [M \<^bold>\<circ> N]"
                                 using MN \<Lambda>.resid_Arr_self \<Lambda>.Arr_not_Nil \<Lambda>.Ide_Trg ide_char by simp
                               show " map (\<lambda>X. \<Lambda>.Trg M \<^bold>\<circ> X) (map \<Lambda>.un_App2 (u # U)) \<^sup>*\<sim>\<^sup>* u # U"
                               proof -
                                 have "map (\<lambda>X. \<Lambda>.Trg M \<^bold>\<circ> X) (map \<Lambda>.un_App2 (u # U)) = u # U"
                                 proof (intro map_App_map_un_App2)
                                   show "Arr (u # U)"
                                     using Std Std_imp_Arr by blast
                                   show "set (u # U) \<subseteq> Collect \<Lambda>.is_App"
                                     using *** u by auto
                                   show "\<Lambda>.Ide (\<Lambda>.Trg M)"
                                     using MN \<Lambda>.Ide_Trg by blast
                                   show "\<Lambda>.un_App1 ` set (u # U) \<subseteq> {\<Lambda>.Trg M}"
                                   proof -
                                     have "\<Lambda>.un_App1 u = \<Lambda>.Trg M"
                                       using * u seq seq_char
                                       apply (cases u)
                                           apply simp_all
                                       by (metis Trg_last_Src_hd_eqI \<Lambda>.Ide_iff_Src_self
                                           \<Lambda>.Src_Src \<Lambda>.Src_Trg \<Lambda>.Src_eq_iff(2) \<Lambda>.Trg.simps(3)
                                           last_ConsL list.sel(1) seq u)
                                     moreover have "Ide (map \<Lambda>.un_App1 (u # U))"
                                       using * Std Std_imp_Arr Arr_map_un_App1
                                       by (metis Collect_cong Ide_char
                                           \<open>Arr (u # U)\<close> \<open>set (u # U) \<subseteq> Collect \<Lambda>.is_App\<close>
                                           \<Lambda>.ide_char list.set_map)
                                     ultimately show ?thesis
                                       using set_Ide_subset_single_hd by force 
                                   qed
                                 qed
                                 thus ?thesis
                                   by (simp add: Resid_Arr_self Std ide_char)
                               qed
                             qed
                             also have "[M \<^bold>\<circ> N] @ u # U = (M \<^bold>\<circ> N) # u # U"
                               by simp
                             finally show ?thesis by blast
                           qed
                         qed
                       qed
                     qed
                     show "\<lbrakk>\<not> \<Lambda>.un_App1 ` set (u # U) \<subseteq> Collect \<Lambda>.Ide;
                            \<Lambda>.un_App2 ` set (u # U) \<subseteq> Collect \<Lambda>.Ide\<rbrakk>
                              \<Longrightarrow> ?thesis"
                     proof -
                       assume *: "\<not> \<Lambda>.un_App1 ` set (u # U) \<subseteq> Collect \<Lambda>.Ide"
                       assume **: "\<Lambda>.un_App2 ` set (u # U) \<subseteq> Collect \<Lambda>.Ide"
                       have 10: "filter notIde (map \<Lambda>.un_App2 (u # U)) = []"
                         using ** by (simp add: subset_eq)
                       hence 4: "stdz_insert (M \<^bold>\<circ> N) (u # U) =
                                 map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
                                     (stdz_insert M (filter notIde (map \<Lambda>.un_App1 (u # U)))) @
                                 map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
                                     (standard_development N)"
                         using u 4 5 * ** Ide_iff_standard_development_empty MN
                         by simp
                       have 6: "\<Lambda>.Ide (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))))"
                         using *** u Std Std_imp_Arr
                         by (metis Arr_imp_arr_last in_mono \<Lambda>.Arr.simps(4) \<Lambda>.Ide_Trg \<Lambda>.arr_char
                             \<Lambda>.lambda.collapse(3) last.simps last_in_set list.discI mem_Collect_eq)
                       show ?thesis
                       proof (intro conjI)
                         show "Std (stdz_insert (M \<^bold>\<circ> N) (u # U))"
                         proof -
                           have "Std (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
                                          (stdz_insert M (filter notIde (map \<Lambda>.un_App1 (u # U)))) @
                                      map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
                                          (standard_development N))"
                           proof (intro Std_append)
                             show "Std (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
                                            (stdz_insert M (filter notIde
                                                                   (map \<Lambda>.un_App1 (u # U)))))"
                               using * A MN Std_map_App1 \<Lambda>.Ide_Src by presburger
                             show "Std (map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
                                       (standard_development N))"
                               using MN 6 Std_map_App2 Std_standard_development by simp
                             show "map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
                                       (stdz_insert M
                                         (filter notIde (map \<Lambda>.un_App1 (u # U)))) = [] \<or>
                                   map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
                                       (standard_development N) = [] \<or>
                                   \<Lambda>.sseq (last (map (\<lambda>X. \<Lambda>.App X (\<Lambda>.Src N))
                                                     (stdz_insert M
                                                       (filter notIde (map \<Lambda>.un_App1 (u # U))))))
                                          (hd (map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
                                                   (standard_development N)))"
                             proof (cases "\<Lambda>.Ide N")
                               show "\<Lambda>.Ide N \<Longrightarrow> ?thesis"
                                 using Ide_iff_standard_development_empty MN by blast
                               assume N: "\<not> \<Lambda>.Ide N"
                               have "\<Lambda>.sseq (last (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
                                                       (stdz_insert M
                                                         (filter notIde (map \<Lambda>.un_App1 (u # U))))))
                                            (hd (map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
                                                     (standard_development N)))"
                               proof -
                                 have "hd (map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
                                                      (standard_development N)) =
                                       \<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))))
                                             (hd (standard_development N))"
                                   by (meson Ide_iff_standard_development_empty MN N list.map_sel(1))
                                 moreover have "last (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
                                                       (stdz_insert M
                                                         (filter notIde (map \<Lambda>.un_App1 (u # U))))) =
                                                \<Lambda>.App (last (stdz_insert M
                                                               (filter notIde
                                                                       (map \<Lambda>.un_App1 (u # U)))))
                                                      (\<Lambda>.Src N)"
                                   by (metis * A Ide.simps(1) Resid.simps(1) ide_char last_map)
                                 moreover have "\<Lambda>.sseq ... (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))))
                                                                   (hd (standard_development N)))"
                                 proof -
                                   have 7: "\<Lambda>.elementary_reduction
                                              (last (stdz_insert M (filter notIde
                                                                   (map \<Lambda>.un_App1 (u # U)))))"
                                     using * A
                                     by (metis Ide.simps(1) Resid.simps(2) ide_char last_in_set
                                         mem_Collect_eq subset_iff)
                                   moreover
                                   have "\<Lambda>.elementary_reduction (hd (standard_development N))"
                                     using MN N hd_in_set set_standard_development
                                           Ide_iff_standard_development_empty
                                     by blast
                                   moreover have "\<Lambda>.Src N = \<Lambda>.Src (hd (standard_development N))"
                                     using MN N Src_hd_standard_development by auto
                                   moreover have "\<Lambda>.Trg (last (stdz_insert M 
                                                                 (filter notIde
                                                                         (map \<Lambda>.un_App1 (u # U))))) =
                                                  \<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))"
                                   proof -
                                     have "[\<Lambda>.Trg (last (stdz_insert M 
                                                           (filter notIde
                                                                   (map \<Lambda>.un_App1 (u # U)))))] =
                                           [\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))]"
                                     proof -
                                       have "\<Lambda>.Trg (last (stdz_insert M
                                                            (filter notIde
                                                                    (map \<Lambda>.un_App1 (u # U))))) =
                                             \<Lambda>.Trg (last (map \<Lambda>.un_App1 (u # U)))"
                                       proof -
                                         have "\<Lambda>.Trg (last (stdz_insert M
                                                              (filter notIde (map \<Lambda>.un_App1 (u # U))))) =
                                               \<Lambda>.Trg (last (M # filter notIde (map \<Lambda>.un_App1 (u # U))))"
                                           using * A Trg_last_eqI by blast
                                         also have "... = \<Lambda>.Trg (last ([M] @ filter notIde
                                                                               (map \<Lambda>.un_App1 (u # U))))"
                                           by simp
                                         also have "... = \<Lambda>.Trg (last (filter notIde
                                                                         (map \<Lambda>.un_App1 (u # U))))"
                                         proof -
                                           have "seq [M] (filter notIde (map \<Lambda>.un_App1 (u # U)))"
                                           proof
                                             show "Arr [M]"
                                               using MN by simp
                                             show "Arr (filter notIde (map \<Lambda>.un_App1 (u # U)))"
                                               using * Std_imp_Arr
                                               by (metis (no_types, lifting)
                                                   X empty_filter_conv list.set_map mem_Collect_eq subsetI)
                                             show "\<Lambda>.Trg (last [M]) =
                                                   \<Lambda>.Src (hd (filter notIde (map \<Lambda>.un_App1 (u # U))))"
                                             proof -
                                               have "\<Lambda>.Trg (last [M]) = \<Lambda>.Trg M"
                                                 using MN by simp
                                               also have "... = \<Lambda>.Src (\<Lambda>.un_App1 u)"
                                                 by (metis Trg_last_Src_hd_eqI \<Lambda>.Src.simps(4)
                                                     \<Lambda>.Trg.simps(3) \<Lambda>.lambda.collapse(3)
                                                     \<Lambda>.lambda.inject(3) last_ConsL list.sel(1) seq u)
                                               also have "... = \<Lambda>.Src (hd (map \<Lambda>.un_App1 (u # U)))"
                                                 by auto
                                               also have "... = \<Lambda>.Src (hd (filter notIde
                                                                          (map \<Lambda>.un_App1 (u # U))))"
                                                 using u 5 10 by force
                                               finally show ?thesis by blast
                                             qed
                                           qed
                                           thus ?thesis by fastforce
                                         qed
                                         also have "... = \<Lambda>.Trg (last (map \<Lambda>.un_App1 (u # U)))"
                                         proof -
                                           have "filter (\<lambda>u. \<not> \<Lambda>.Ide u) (map \<Lambda>.un_App1 (u # U)) \<^sup>*\<sim>\<^sup>*
                                                 map \<Lambda>.un_App1 (u # U)"
                                             using * *** u Std Std_imp_Arr Arr_map_un_App1 [of "u # U"]
                                                   cong_filter_notIde
                                             by (metis (mono_tags, lifting) empty_filter_conv
                                                 filter_notIde_Ide list.discI list.set_map
                                                 mem_Collect_eq set_ConsD subset_code(1))
                                           thus ?thesis
                                             using cong_implies_coterminal Trg_last_eqI
                                             by presburger
                                         qed
                                         finally show ?thesis by blast
                                       qed
                                       thus ?thesis
                                         by (simp add: last_map)
                                     qed
                                     moreover
                                     have "\<Lambda>.Ide (\<Lambda>.Trg (last (stdz_insert M
                                                                 (filter notIde
                                                                         (map \<Lambda>.un_App1 (u # U))))))"
                                       using 7 \<Lambda>.Ide_Trg \<Lambda>.elementary_reduction_is_arr by blast
                                     moreover have "\<Lambda>.Ide (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))))"
                                       using 6 by blast
                                     ultimately show ?thesis by simp
                                   qed
                                   ultimately show ?thesis
                                     using \<Lambda>.sseq.simps(4) by blast
                                 qed
                                 ultimately show ?thesis by argo
                               qed
                               thus ?thesis by blast
                             qed
                           qed
                           thus ?thesis
                             using 4 by simp
                         qed
                         show "\<not> Ide ((M \<^bold>\<circ> N) # u # U) \<longrightarrow>
                                   stdz_insert (M \<^bold>\<circ> N) (u # U) \<^sup>*\<sim>\<^sup>* (M \<^bold>\<circ> N) # u # U"
                         proof
                           show "stdz_insert (M \<^bold>\<circ> N) (u # U) \<^sup>*\<sim>\<^sup>* (M \<^bold>\<circ> N) # u # U"
                           proof (cases "\<Lambda>.Ide N")
                             assume N: "\<Lambda>.Ide N"
                             have "stdz_insert (M \<^bold>\<circ> N) (u # U) =
                                   map (\<lambda>X. X \<^bold>\<circ> N)
                                       (stdz_insert M (filter notIde
                                                      (map \<Lambda>.un_App1 (u # U))))"
                               using 4 N MN Ide_iff_standard_development_empty \<Lambda>.Ide_iff_Src_self
                               by force
                             also have "... \<^sup>*\<sim>\<^sup>* map (\<lambda>X. X \<^bold>\<circ> N)
                                                    (M # filter notIde
                                                                (map \<Lambda>.un_App1 (u # U)))"
                               using * A MN N \<Lambda>.Ide_Src cong_map_App2 \<Lambda>.Ide_iff_Src_self
                               by blast
                             also have "map (\<lambda>X. X \<^bold>\<circ> N)
                                            (M # filter notIde
                                                        (map \<Lambda>.un_App1 (u # U))) =
                                        [M \<^bold>\<circ> N] @
                                          map (\<lambda>X. \<Lambda>.App X N)
                                              (filter notIde (map \<Lambda>.un_App1 (u # U)))"
                               by auto
                             also have "[M \<^bold>\<circ> N] @
                                          map (\<lambda>X. X \<^bold>\<circ> N)
                                              (filter notIde (map \<Lambda>.un_App1 (u # U))) \<^sup>*\<sim>\<^sup>*
                                        [M \<^bold>\<circ> N] @ map (\<lambda>X. X \<^bold>\<circ> N) (map \<Lambda>.un_App1 (u # U))"
                             proof (intro cong_append)
                               show "seq [M \<^bold>\<circ> N]
                                         (map (\<lambda>X. X \<^bold>\<circ> N)
                                              (filter notIde (map \<Lambda>.un_App1 (u # U))))"
                               proof
                                 have 20: "Arr (map \<Lambda>.un_App1 (u # U))"
                                   using *** u Std Arr_map_un_App1
                                   by (metis Std_imp_Arr insert_subset list.discI list.simps(15)
                                       mem_Collect_eq)
                                 show "Arr [M \<^bold>\<circ> N]"
                                   using MN by auto
                                 show 21: "Arr (map (\<lambda>X. X \<^bold>\<circ> N)
                                                    (filter notIde (map \<Lambda>.un_App1 (u # U))))"
                                 proof -
                                   have "Arr (filter notIde (map \<Lambda>.un_App1 (u # U)))"
                                     using u 20 cong_filter_notIde
                                     by (metis (no_types, lifting) * Std_imp_Arr
                                         \<open>Std (filter notIde (map \<Lambda>.un_App1 (u # U)))\<close>
                                         empty_filter_conv list.set_map mem_Collect_eq subsetI)
                                   thus ?thesis
                                     using MN N Arr_map_App1 \<Lambda>.Ide_Src by presburger
                                 qed
                                 show "\<Lambda>.Trg (last [M \<^bold>\<circ> N]) =
                                       \<Lambda>.Src (hd (map (\<lambda>X. X \<^bold>\<circ> N)
                                                      (filter notIde (map \<Lambda>.un_App1 (u # U)))))"
                                 proof -
                                   have "\<Lambda>.Trg (last [M \<^bold>\<circ> N]) = \<Lambda>.Trg M \<^bold>\<circ> N"
                                     using MN N \<Lambda>.Ide_iff_Trg_self by simp
                                   also have "... = \<Lambda>.Src (\<Lambda>.un_App1 u) \<^bold>\<circ> N"
                                     using MN u seq seq_char
                                     by (metis Trg_last_Src_hd_eqI calculation \<Lambda>.Src_Src \<Lambda>.Src_Trg
                                         \<Lambda>.Src_eq_iff(2) \<Lambda>.is_App_def \<Lambda>.lambda.sel(3) list.sel(1))
                                   also have "... = \<Lambda>.Src (\<Lambda>.un_App1 u \<^bold>\<circ> N)"
                                     using MN N \<Lambda>.Ide_iff_Src_self by simp
                                   also have "... = \<Lambda>.Src (hd (map (\<lambda>X. X \<^bold>\<circ> N)
                                                                   (map \<Lambda>.un_App1 (u # U))))"
                                     by simp
                                   also have "... = \<Lambda>.Src (hd (map (\<lambda>X. X \<^bold>\<circ> N)
                                                                   (filter notIde
                                                                           (map \<Lambda>.un_App1 (u # U)))))"
                                   proof -
                                     have "cong (map \<Lambda>.un_App1 (u # U))
                                                (filter notIde (map \<Lambda>.un_App1 (u # U)))"
                                       using * 20 21 cong_filter_notIde
                                       by (metis Arr.simps(1) filter_notIde_Ide map_is_Nil_conv)
                                     thus ?thesis
                                       by (metis (no_types, lifting) Ide.simps(1) Resid.simps(2)
                                           Src_hd_eqI hd_map ide_char \<Lambda>.Src.simps(4)
                                           list.distinct(1) list.simps(9))
                                   qed
                                   finally show ?thesis by blast
                                 qed
                               qed
                               show "cong [M \<^bold>\<circ> N] [M \<^bold>\<circ> N]"
                                 using MN
                                 by (meson head_redex_decomp \<Lambda>.Arr.simps(4) \<Lambda>.Arr_Src
                                     prfx_transitive)
                               show "map (\<lambda>X. X \<^bold>\<circ> N) (filter notIde (map \<Lambda>.un_App1 (u # U))) \<^sup>*\<sim>\<^sup>*
                                     map (\<lambda>X. X \<^bold>\<circ> N) (map \<Lambda>.un_App1 (u # U))"
                               proof -
                                 have "Arr (map \<Lambda>.un_App1 (u # U))"
                                   using *** u Std Arr_map_un_App1
                                   by (metis Std_imp_Arr insert_subset list.discI list.simps(15)
                                       mem_Collect_eq)
                                 moreover have "\<not> Ide (map \<Lambda>.un_App1 (u # U))"
                                   using *
                                   by (metis Collect_cong \<Lambda>.ide_char list.set_map
                                       set_Ide_subset_ide)
                                 ultimately show ?thesis
                                   using *** u MN N cong_filter_notIde cong_map_App2
                                   by (meson \<Lambda>.Ide_Src)
                               qed
                             qed
                             also have "[M \<^bold>\<circ> N] @ map (\<lambda>X. X \<^bold>\<circ> N) (map \<Lambda>.un_App1 (u # U)) \<^sup>*\<sim>\<^sup>*
                                        [M \<^bold>\<circ> N] @ u # U"
                             proof -
                               have "map (\<lambda>X. X \<^bold>\<circ> N) (map \<Lambda>.un_App1 (u # U)) \<^sup>*\<sim>\<^sup>* u # U"
                               proof -
                                 have "map (\<lambda>X. X \<^bold>\<circ> N) (map \<Lambda>.un_App1 (u # U)) = u # U"
                                 proof (intro map_App_map_un_App1)
                                   show "Arr (u # U)"
                                     using Std Std_imp_Arr by simp
                                   show "set (u # U) \<subseteq> Collect \<Lambda>.is_App"
                                     using *** u by auto
                                   show "\<Lambda>.Ide N"
                                     using N by simp
                                   show "\<Lambda>.un_App2 ` set (u # U) \<subseteq> {N}"
                                   proof -
                                     have "\<Lambda>.Src (\<Lambda>.un_App2 u) = \<Lambda>.Trg N"
                                       using ** seq u seq_char N
                                       apply (cases u)
                                           apply simp_all
                                       by (metis Trg_last_Src_hd_eqI \<Lambda>.Src.simps(4) \<Lambda>.Trg.simps(3)
                                           \<Lambda>.lambda.inject(3) last_ConsL list.sel(1) seq)
                                     moreover have "\<Lambda>.Ide (\<Lambda>.un_App2 u) \<and> \<Lambda>.Ide N"
                                       using ** N by simp
                                     moreover have "Ide (map \<Lambda>.un_App2 (u # U))"
                                       using ** Std Std_imp_Arr Arr_map_un_App2
                                       by (metis Collect_cong Ide_char
                                           \<open>Arr (u # U)\<close> \<open>set (u # U) \<subseteq> Collect \<Lambda>.is_App\<close>
                                           \<Lambda>.ide_char list.set_map)
                                     ultimately show ?thesis
                                       by (metis hd_map \<Lambda>.Ide_iff_Src_self \<Lambda>.Ide_iff_Trg_self
                                           \<Lambda>.Ide_implies_Arr list.discI list.sel(1)
                                           list.set_map set_Ide_subset_single_hd)
                                   qed
                                 qed
                                 thus ?thesis
                                   by (simp add: Resid_Arr_self Std ide_char)
                               qed
                               thus ?thesis
                                 using MN cong_append
                                 by (metis (no_types, lifting) 1 cong_standard_development
                                     cong_transitive \<Lambda>.Arr.simps(4) seq)
                             qed
                             also have "[M \<^bold>\<circ> N] @ (u # U) = (M \<^bold>\<circ> N) # u # U"
                               by simp
                             finally show ?thesis by blast
                             next
                             assume N: "\<not> \<Lambda>.Ide N"
                             have "stdz_insert (M \<^bold>\<circ> N) (u # U) =
                                   map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
                                       (stdz_insert M (filter notIde (map \<Lambda>.un_App1 (u # U)))) @
                                   map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
                                       (standard_development N)"
                               using 4 by simp
                             also have "... \<^sup>*\<sim>\<^sup>* map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
                                                    (M # filter notIde (map \<Lambda>.un_App1 (u # U))) @
                                                      map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))))) [N]"
                             proof (intro cong_append)
                               show 23: "map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
                                             (stdz_insert M (filter notIde (map \<Lambda>.un_App1 (u # U)))) \<^sup>*\<sim>\<^sup>*
                                         map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
                                             (M # filter notIde (map \<Lambda>.un_App1 (u # U)))"
                                 using * A MN \<Lambda>.Ide_Src cong_map_App2 by blast
                               show 22: "map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
                                             (standard_development N) \<^sup>*\<sim>\<^sup>*
                                         map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))))) [N]"
                                 using 6 *** u Std Std_imp_Arr MN N cong_standard_development
                                       cong_map_App1
                                 by presburger
                               show "seq (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
                                              (stdz_insert M (filter notIde
                                                             (map \<Lambda>.un_App1 (u # U)))))
                                         (map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
                                              (standard_development N))"
                               proof -
                                 have "seq (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
                                                (M # filter notIde
                                                            (map \<Lambda>.un_App1 (u # U))))
                                           (map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))))) [N])"
                                 proof
                                   show 26: "Arr (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
                                                  (M # filter notIde
                                                              (map \<Lambda>.un_App1 (u # U))))"
                                     by (metis 23 Con_implies_Arr(2) Ide.simps(1) ide_char)
                                   show "Arr (map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))))) [N])"
                                     by (meson 22 arr_char con_implies_arr(2) prfx_implies_con)   
                                   show "\<Lambda>.Trg (last (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
                                                          (M # filter notIde
                                                                      (map \<Lambda>.un_App1 (u # U))))) =
                                         \<Lambda>.Src (hd (map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
                                                        [N]))"
                                   proof -
                                     have "\<Lambda>.Trg (last (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
                                                            (M # map \<Lambda>.un_App1 (u # U))))
                                            \<sim>
                                           \<Lambda>.Trg (last (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
                                                                     (M # filter notIde
                                                                            (map \<Lambda>.un_App1 (u # U)))))"
                                     proof -
                                       have "targets (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
                                                          (M # filter notIde
                                                                      (map \<Lambda>.un_App1 (u # U)))) =
                                             targets (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
                                                          (M # map \<Lambda>.un_App1 (u # U)))"
                                       proof -
                                         have "map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
                                                   (M # filter notIde (map \<Lambda>.un_App1 (u # U))) \<^sup>*\<sim>\<^sup>*
                                               map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
                                                   (M # map \<Lambda>.un_App1 (u # U))"
                                         proof -
                                           have "map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
                                                     (M # map \<Lambda>.un_App1 (u # U)) =
                                                 map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
                                                     ([M] @ map \<Lambda>.un_App1 (u # U))"
                                             by simp
                                           also have "cong ... (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
                                                                    ([M] @ filter notIde
                                                                            (map \<Lambda>.un_App1 (u # U))))"
                                           proof -
                                             have "[M] @ map \<Lambda>.un_App1 (u # U) \<^sup>*\<sim>\<^sup>*
                                                   [M] @ filter notIde
                                                                (map \<Lambda>.un_App1 (u # U))"
                                             proof (intro cong_append)
                                               show "cong [M] [M]"
                                                 using MN
                                                 by (meson head_redex_decomp prfx_transitive)
                                               show "seq [M] (map \<Lambda>.un_App1 (u # U))"
                                               proof
                                                 show "Arr [M]"
                                                   using MN by simp
                                                 show "Arr (map \<Lambda>.un_App1 (u # U))"
                                                   using *** u Std Arr_map_un_App1
                                                   by (metis Std_imp_Arr insert_subset list.discI
                                                       list.simps(15) mem_Collect_eq)
                                                 show "\<Lambda>.Trg (last [M]) =
                                                       \<Lambda>.Src (hd (map \<Lambda>.un_App1 (u # U)))"
                                                   using MN u seq seq_char Srcs_simp\<^sub>\<Lambda>\<^sub>P by auto
                                               qed
                                               show "cong (map \<Lambda>.un_App1 (u # U))
                                                          (filter notIde
                                                                  (map \<Lambda>.un_App1 (u # U)))"
                                               proof -
                                                 have "Arr (map \<Lambda>.un_App1 (u # U))"
                                                   by (metis *** Arr_map_un_App1 Std Std_imp_Arr
                                                       insert_subset list.discI list.simps(15)
                                                       mem_Collect_eq u)
                                                 moreover have "\<not> Ide (map \<Lambda>.un_App1 (u # U))"
                                                   using * set_Ide_subset_ide by fastforce
                                                 ultimately show ?thesis
                                                   using cong_filter_notIde by blast
                                               qed
                                             qed
                                             thus "map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
                                                       ([M] @ map \<Lambda>.un_App1 (u # U)) \<^sup>*\<sim>\<^sup>*
                                                   map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
                                                       ([M] @ filter notIde (map \<Lambda>.un_App1 (u # U)))"
                                               using MN cong_map_App2 \<Lambda>.Ide_Src by presburger
                                           qed
                                           finally show ?thesis by simp
                                         qed
                                         thus ?thesis
                                           using cong_implies_coterminal by blast
                                       qed
                                       moreover have "[\<Lambda>.Trg (last (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
                                                                        (M # map \<Lambda>.un_App1 (u # U))))] \<in>
                                                      targets (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
                                                                   (M # map \<Lambda>.un_App1 (u # U)))"
                                         by (metis (no_types, lifting) 26 calculation mem_Collect_eq
                                             single_Trg_last_in_targets targets_char\<^sub>\<Lambda>\<^sub>P)
                                       moreover have "[\<Lambda>.Trg (last (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
                                                                   (M # filter notIde
                                                                          (map \<Lambda>.un_App1 (u # U)))))] \<in>
                                                      targets (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
                                                              (M # filter notIde
                                                                          (map \<Lambda>.un_App1 (u # U))))"
                                         using 26 single_Trg_last_in_targets by blast
                                       ultimately show ?thesis
                                         by (metis (no_types, lifting) 26 Ide.simps(1-2) Resid_rec(1)
                                             in_targets_iff ide_char)
                                     qed
                                     moreover have "\<Lambda>.Ide (\<Lambda>.Trg (last (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
                                                                             (M # map \<Lambda>.un_App1 (u # U)))))"
                                       by (metis 6 MN \<Lambda>.Ide.simps(4) \<Lambda>.Ide_Src \<Lambda>.Trg.simps(3)
                                           \<Lambda>.Trg_Src last_ConsR last_map list.distinct(1)
                                           list.simps(9))
                                     moreover have "\<Lambda>.Ide (\<Lambda>.Trg (last (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
                                                                             (M # filter notIde
                                                                                    (map \<Lambda>.un_App1 (u # U))))))"
                                       using \<Lambda>.ide_backward_stable calculation(1-2) by fast
                                     ultimately show ?thesis
                                       by (metis (no_types, lifting) 6 MN hd_map
                                           \<Lambda>.Ide_iff_Src_self \<Lambda>.Ide_implies_Arr \<Lambda>.Src.simps(4)
                                           \<Lambda>.Trg.simps(3) \<Lambda>.Trg_Src \<Lambda>.cong_Ide_are_eq
                                           last.simps last_map list.distinct(1) list.map_disc_iff
                                           list.sel(1))
                                   qed
                                 qed
                                 thus ?thesis
                                   using 22 23 cong_respects_seq\<^sub>P by presburger
                               qed
                             qed
                             also have "map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
                                            (M # filter notIde (map \<Lambda>.un_App1 (u # U))) @
                                          map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))))) [N] =
                                        [M \<^bold>\<circ> \<Lambda>.Src N] @
                                           map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
                                               (filter notIde (map \<Lambda>.un_App1 (u # U))) @
                                            [\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))) N]"
                               by simp
                             also have 1: "[M \<^bold>\<circ> \<Lambda>.Src N] @
                                             map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
                                                 (filter notIde (map \<Lambda>.un_App1 (u # U))) @
                                              [\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))) N] \<^sup>*\<sim>\<^sup>*
                                           [M \<^bold>\<circ> \<Lambda>.Src N] @
                                             map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N) (map \<Lambda>.un_App1 (u # U)) @
                                               [\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))) N]"
                             proof (intro cong_append)
                               show "[M \<^bold>\<circ> \<Lambda>.Src N] \<^sup>*\<sim>\<^sup>* [M \<^bold>\<circ> \<Lambda>.Src N]"
                                 using MN
                                 by (meson head_redex_decomp lambda_calculus.Arr.simps(4)
                                     lambda_calculus.Arr_Src prfx_transitive)
                               show 21: "map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
                                             (filter notIde (map \<Lambda>.un_App1 (u # U))) \<^sup>*\<sim>\<^sup>*
                                         map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N) (map \<Lambda>.un_App1 (u # U))"
                               proof -
                                 have "filter notIde (map \<Lambda>.un_App1 (u # U)) \<^sup>*\<sim>\<^sup>*
                                       map \<Lambda>.un_App1 (u # U)"
                                 proof -
                                   have "\<not> Ide (map \<Lambda>.un_App1 (u # U))"
                                     using *
                                     by (metis Collect_cong \<Lambda>.ide_char list.set_map
                                         set_Ide_subset_ide)
                                   thus ?thesis
                                     using *** u Std Std_imp_Arr Arr_map_un_App1
                                           cong_filter_notIde
                                     by (metis \<open>\<not> Ide (map \<Lambda>.un_App1 (u # U))\<close>
                                         list.distinct(1) mem_Collect_eq set_ConsD
                                         subset_code(1))
                                 qed
                                 thus ?thesis
                                   using MN cong_map_App2 [of "\<Lambda>.Src N"] \<Lambda>.Ide_Src by presburger
                               qed
                               show "[\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))) \<^bold>\<circ> N] \<^sup>*\<sim>\<^sup>*
                                     [\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))) \<^bold>\<circ> N]"
                                 by (metis "6" Con_implies_Arr(1) MN \<Lambda>.Ide_implies_Arr arr_char
                                     cong_reflexive \<Lambda>.Ide_iff_Src_self neq_Nil_conv
                                     orthogonal_App_single_single(1))
                               show "seq (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
                                              (filter notIde (map \<Lambda>.un_App1 (u # U))))
                                         [\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))) \<^bold>\<circ> N]"
                               proof
                                 show "Arr (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
                                                (filter notIde (map \<Lambda>.un_App1 (u # U))))"
                                   by (metis 21 Con_implies_Arr(2) Ide.simps(1) ide_char)
                                 show "Arr [\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))) \<^bold>\<circ> N]"
                                   by (metis Con_implies_Arr(2) Ide.simps(1)
                                       \<open>[\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))) \<^bold>\<circ> N] \<^sup>*\<sim>\<^sup>*
                                        [\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))) \<^bold>\<circ> N]\<close>
                                       ide_char)
                                 show "\<Lambda>.Trg (last (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
                                                   (filter notIde
                                                           (map \<Lambda>.un_App1 (u # U))))) =
                                       \<Lambda>.Src (hd [\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))) \<^bold>\<circ> N])"
                                   by (metis (no_types, lifting) 6 21 MN Trg_last_eqI
                                       \<Lambda>.Ide_iff_Src_self \<Lambda>.Ide_implies_Arr \<Lambda>.Src.simps(4)
                                       \<Lambda>.Trg.simps(3) \<Lambda>.Trg_Src last_map list.distinct(1)
                                       list.map_disc_iff list.sel(1))
                               qed
                               show "seq [M \<^bold>\<circ> \<Lambda>.Src N]
                                         (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
                                              (filter notIde (map \<Lambda>.un_App1 (u # U))) @
                                           [\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))) \<^bold>\<circ> N])"
                               proof
                                 show "Arr [M \<^bold>\<circ> \<Lambda>.Src N]"
                                   using MN by simp
                                 show "Arr (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
                                                (filter notIde (map \<Lambda>.un_App1 (u # U))) @
                                              [\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))) \<^bold>\<circ> N])"
                                   apply (intro Arr_appendI\<^sub>P)
                                     apply (metis 21 Con_implies_Arr(2) Ide.simps(1) ide_char)
                                    apply (metis Con_implies_Arr(1) Ide.simps(1)
                                       \<open>[\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))) \<^bold>\<circ> N] \<^sup>*\<sim>\<^sup>*
                                        [\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))) \<^bold>\<circ> N]\<close> ide_char)
                                   by (metis (no_types, lifting) "21" Arr.simps(1)
                                       Arr_append_iff\<^sub>P Con_implies_Arr(2) Ide.simps(1)
                                       append_is_Nil_conv calculation ide_char not_Cons_self2)
                                 show "\<Lambda>.Trg (last [M \<^bold>\<circ> \<Lambda>.Src N]) =
                                       \<Lambda>.Src (hd (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
                                                      (filter notIde
                                                              (map \<Lambda>.un_App1 (u # U))) @
                                                         [\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))) \<^bold>\<circ> N]))"
                                   by (metis (no_types, lifting) Con_implies_Arr(2) Ide.simps(1)
                                       Trg_last_Src_hd_eqI append_is_Nil_conv arr_append_imp_seq
                                       arr_char calculation ide_char not_Cons_self2)
                                qed
                             qed
                             also have "[M \<^bold>\<circ> \<Lambda>.Src N] @
                                          map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)(map \<Lambda>.un_App1 (u # U)) @
                                            [\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))) \<^bold>\<circ> N] \<^sup>*\<sim>\<^sup>*
                                        [M \<^bold>\<circ> \<Lambda>.Src N] @
                                          [\<Lambda>.Trg M \<^bold>\<circ> N] @
                                            map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg N) (map \<Lambda>.un_App1 (u # U))"
                             proof (intro cong_append [of "[\<Lambda>.App M (\<Lambda>.Src N)]"])
                               show "seq [M \<^bold>\<circ> \<Lambda>.Src N]
                                         (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
                                              (map \<Lambda>.un_App1 (u # U)) @
                                                 [\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))) \<^bold>\<circ> N])"
                               proof
                                 show "Arr [M \<^bold>\<circ> \<Lambda>.Src N]"
                                   using MN by simp
                                 show "Arr (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
                                                (map \<Lambda>.un_App1 (u # U)) @ 
                                                   [\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))) \<^bold>\<circ> N])"
                                   by (metis (no_types, lifting) 1 Con_append(2) Con_implies_Arr(2)
                                       Ide.simps(1) append_is_Nil_conv ide_char not_Cons_self2)
                                 show "\<Lambda>.Trg (last [M \<^bold>\<circ> \<Lambda>.Src N]) =
                                       \<Lambda>.Src (hd (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
                                                      (map \<Lambda>.un_App1 (u # U)) @
                                                    [\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))) \<^bold>\<circ> N]))"
                                 proof -
                                   have "\<Lambda>.Trg M = \<Lambda>.Src (\<Lambda>.un_App1 u)"
                                     using u seq
                                     by (metis Trg_last_Src_hd_eqI \<Lambda>.Src.simps(4) \<Lambda>.Trg.simps(3)
                                         \<Lambda>.lambda.collapse(3) \<Lambda>.lambda.inject(3) last_ConsL
                                         list.sel(1))
                                   thus ?thesis
                                     using MN by auto
                                 qed
                               qed
                               show "[M \<^bold>\<circ> \<Lambda>.Src N] \<^sup>*\<sim>\<^sup>* [M \<^bold>\<circ> \<Lambda>.Src N]"
                                 using MN
                                 by (metis head_redex_decomp \<Lambda>.Arr.simps(4) \<Lambda>.Arr_Src
                                     prfx_transitive)
                               show "map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N) (map \<Lambda>.un_App1 (u # U)) @
                                       [\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))) \<^bold>\<circ> N] \<^sup>*\<sim>\<^sup>*
                                     [\<Lambda>.Trg M \<^bold>\<circ> N] @
                                       map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg N) (map \<Lambda>.un_App1 (u # U))"
                               proof -
                                 have "map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src (hd [N])) (map \<Lambda>.un_App1 (u # U)) @
                                         map (\<Lambda>.App (\<Lambda>.Trg (last (map \<Lambda>.un_App1 (u # U))))) [N] \<^sup>*\<sim>\<^sup>*
                                       map (\<Lambda>.App (\<Lambda>.Src (hd (map \<Lambda>.un_App1 (u # U))))) [N] @
                                         map  (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg (last [N])) (map \<Lambda>.un_App1 (u # U))"
                                 proof -
                                   have "Arr (map \<Lambda>.un_App1 (u # U))"
                                     using Std *** u Arr_map_un_App1
                                     by (metis Std_imp_Arr insert_subset list.discI list.simps(15)
                                         mem_Collect_eq)
                                   moreover have "Arr [N]"
                                     using MN by simp
                                   ultimately show ?thesis
                                     using orthogonal_App_cong by blast
                                 qed
                                 moreover
                                 have "map (\<Lambda>.App (\<Lambda>.Src (hd (map \<Lambda>.un_App1 (u # U))))) [N] =
                                       [\<Lambda>.Trg M \<^bold>\<circ> N]"
                                   by (metis Trg_last_Src_hd_eqI lambda_calculus.Src.simps(4)
                                       \<Lambda>.Trg.simps(3) \<Lambda>.lambda.collapse(3) \<Lambda>.lambda.sel(3)
                                       last_ConsL list.sel(1) list.simps(8) list.simps(9) seq u)
                                 moreover have "[\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))) \<^bold>\<circ> N] =
                                                map (\<Lambda>.App (\<Lambda>.Trg (last (map \<Lambda>.un_App1 (u # U))))) [N]"
                                   by (simp add: last_map)
                                 ultimately show ?thesis
                                   using last_map by auto
                               qed
                             qed
                             also have "[M \<^bold>\<circ> \<Lambda>.Src N] @
                                          [\<Lambda>.Trg M \<^bold>\<circ> N] @
                                            map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg N) (map \<Lambda>.un_App1 (u # U)) =
                                        ([M \<^bold>\<circ> \<Lambda>.Src N] @ [\<Lambda>.Trg M \<^bold>\<circ> N]) @
                                           map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg N) (map \<Lambda>.un_App1 (u # U))"
                               by simp
                             also have "... \<^sup>*\<sim>\<^sup>* [M \<^bold>\<circ> N] @ (u # U)"
                             proof (intro cong_append)
                               show "[M \<^bold>\<circ> \<Lambda>.Src N] @ [\<Lambda>.Trg M \<^bold>\<circ> N] \<^sup>*\<sim>\<^sup>* [M \<^bold>\<circ> N]"
                                 using MN \<Lambda>.resid_Arr_self \<Lambda>.Arr_not_Nil \<Lambda>.Ide_Trg ide_char
                                 by auto
                               show 1: "map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg N) (map \<Lambda>.un_App1 (u # U)) \<^sup>*\<sim>\<^sup>* u # U"
                               proof -
                                 have "map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg N) (map \<Lambda>.un_App1 (u # U)) = u # U"
                                 proof (intro map_App_map_un_App1)
                                   show "Arr (u # U)"
                                     using Std Std_imp_Arr by simp
                                   show "set (u # U) \<subseteq> Collect \<Lambda>.is_App"
                                     using "***" u by auto
                                   show "\<Lambda>.Ide (\<Lambda>.Trg N)"
                                     using MN \<Lambda>.Ide_Trg by simp
                                   show "\<Lambda>.un_App2 ` set (u # U) \<subseteq> {\<Lambda>.Trg N}"
                                   proof -
                                     have "\<Lambda>.Src (\<Lambda>.un_App2 u) = \<Lambda>.Trg N"
                                       using u seq seq_char
                                       apply (cases u)
                                           apply simp_all
                                       by (metis Trg_last_Src_hd_eqI \<Lambda>.Src.simps(4) \<Lambda>.Trg.simps(3)
                                           \<Lambda>.lambda.inject(3) last_ConsL list.sel(1) seq)
                                     moreover have "\<Lambda>.Ide (\<Lambda>.un_App2 u)"
                                       using ** by simp
                                     moreover have "Ide (map \<Lambda>.un_App2 (u # U))"
                                       using ** Std Std_imp_Arr Arr_map_un_App2
                                       by (metis Collect_cong Ide_char
                                           \<open>Arr (u # U)\<close> \<open>set (u # U) \<subseteq> Collect \<Lambda>.is_App\<close>
                                           \<Lambda>.ide_char list.set_map)
                                     ultimately show ?thesis
                                       by (metis \<Lambda>.Ide_iff_Src_self \<Lambda>.Ide_implies_Arr list.sel(1)
                                           list.set_map list.simps(9) set_Ide_subset_single_hd
                                           singleton_insert_inj_eq)
                                   qed
                                 qed
                                 thus ?thesis
                                   by (simp add: Resid_Arr_self Std ide_char)
                               qed
                               show "seq ([M \<^bold>\<circ> \<Lambda>.Src N] @ [\<Lambda>.Trg M \<^bold>\<circ> N])
                                         (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg N) (map \<Lambda>.un_App1 (u # U)))"
                               proof
                                 show "Arr ([M \<^bold>\<circ> \<Lambda>.Src N] @ [\<Lambda>.Trg M \<^bold>\<circ> N])"
                                   using MN by simp
                                 show "Arr (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg N) (map \<Lambda>.un_App1 (u # U)))"
                                   using MN Std Std_imp_Arr Arr_map_un_App1 Arr_map_App1
                                   by (metis 1 Con_implies_Arr(1) Ide.simps(1) ide_char)
                                 show "\<Lambda>.Trg (last ([M \<^bold>\<circ> \<Lambda>.Src N] @ [\<Lambda>.Trg M \<^bold>\<circ> N])) =
                                       \<Lambda>.Src (hd (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg N) (map \<Lambda>.un_App1 (u # U))))"
                                   using MN Std Std_imp_Arr Arr_map_un_App1 Arr_map_App1
                                         seq seq_char u Srcs_simp\<^sub>\<Lambda>\<^sub>P by auto
                               qed
                             qed
                             also have "[M \<^bold>\<circ> N] @ (u # U) = (M \<^bold>\<circ> N) # u # U"
                               by simp
                             finally show ?thesis by blast
                           qed
                         qed
                       qed
                     qed
                     show "\<lbrakk>\<not> \<Lambda>.un_App1 ` set (u # U) \<subseteq> Collect \<Lambda>.Ide;
                            \<not> \<Lambda>.un_App2 ` set (u # U) \<subseteq> Collect \<Lambda>.Ide\<rbrakk>
                              \<Longrightarrow> ?thesis"
                     proof -
                       assume *: "\<not> \<Lambda>.un_App1 ` set (u # U) \<subseteq> Collect \<Lambda>.Ide"
                       assume **: "\<not> \<Lambda>.un_App2 ` set (u # U) \<subseteq> Collect \<Lambda>.Ide"
                       show ?thesis
                       proof (intro conjI)
                         show "Std (stdz_insert (M \<^bold>\<circ> N) (u # U))"
                         proof -
                           have "Std (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
                                          (stdz_insert M (filter notIde (map \<Lambda>.un_App1 (u # U)))) @
                                      map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
                                          (stdz_insert N (filter notIde (map \<Lambda>.un_App2 (u # U)))))"
                           proof (intro Std_append)
                             show "Std (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
                                       (stdz_insert M (filter notIde (map \<Lambda>.un_App1 (u # U)))))"
                               using * A \<Lambda>.Ide_Src MN Std_map_App1 by presburger
                             show "Std (map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
                                       (stdz_insert N (filter notIde (map \<Lambda>.un_App2 (u # U)))))"
                             proof - 
                               have "\<Lambda>.Arr (\<Lambda>.un_App1 (last (u # U)))"
                                 by (metis *** \<Lambda>.Arr.simps(4) Std Std_imp_Arr Arr.simps(2)
                                     Arr_append_iff\<^sub>P append_butlast_last_id append_self_conv2
                                     \<Lambda>.arr_char \<Lambda>.lambda.collapse(3) last.simps last_in_set
                                     list.discI mem_Collect_eq subset_code(1) u)
                               thus ?thesis
                                 using ** B \<Lambda>.Ide_Trg MN Std_map_App2 by presburger
                             qed
                             show "map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
                                       (stdz_insert M (filter notIde (map \<Lambda>.un_App1 (u # U)))) = [] \<or>
                                   map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
                                       (stdz_insert N (filter notIde (map \<Lambda>.un_App2 (u # U)))) = [] \<or>
                                   \<Lambda>.sseq (last (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
                                                (stdz_insert M (filter notIde (map \<Lambda>.un_App1 (u # U))))))
                                          (hd (map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
                                                   (stdz_insert N (filter notIde (map \<Lambda>.un_App2 (u # U))))))"
                             proof -
                               have "\<Lambda>.sseq (last (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
                                                  (stdz_insert M (filter notIde (map \<Lambda>.un_App1 (u # U))))))
                                            (hd (map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
                                                (stdz_insert N (filter notIde (map \<Lambda>.un_App2 (u # U))))))"
                               proof -
                                 let ?M = "\<Lambda>.un_App1 (last (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
                                                           (stdz_insert M
                                                             (filter notIde
                                                                     (map \<Lambda>.un_App1 (u # U))))))"
                                 let ?M' = "\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))"
                                 let ?N = "\<Lambda>.Src N"
                                 let ?N' = "\<Lambda>.un_App2
                                              (hd (map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
                                                       (stdz_insert N
                                                         (filter notIde
                                                                 (map \<Lambda>.un_App2 (u # U))))))"
                                 have M: "?M = last (stdz_insert M
                                                      (filter notIde (map \<Lambda>.un_App1 (u # U))))"
                                   by (metis * A Ide.simps(1) Resid.simps(1) ide_char
                                       \<Lambda>.lambda.sel(3) last_map)
                                 have N': "?N' = hd (stdz_insert N
                                                      (filter notIde (map \<Lambda>.un_App2 (u # U))))"
                                   by (metis ** B Ide.simps(1) Resid.simps(2) ide_char
                                       \<Lambda>.lambda.sel(4) hd_map)
                                 have AppMN: "last (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
                                                   (stdz_insert M
                                                     (filter notIde (map \<Lambda>.un_App1 (u # U))))) =
                                              ?M \<^bold>\<circ> ?N"
                                   by (metis * A Ide.simps(1) M Resid.simps(2) ide_char last_map)
                                 moreover
                                 have 4: "hd (map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
                                                  (stdz_insert N
                                                    (filter notIde (map \<Lambda>.un_App2 (u # U))))) =
                                          ?M' \<^bold>\<circ> ?N'"
                                   by (metis (no_types, lifting) ** B Resid.simps(2) con_char
                                       prfx_implies_con \<Lambda>.lambda.collapse(3) \<Lambda>.lambda.discI(3)
                                       \<Lambda>.lambda.inject(3) list.map_sel(1))
                                 moreover have MM: "\<Lambda>.elementary_reduction ?M"
                                   by (metis * A Arr.simps(1) Con_implies_Arr(2) Ide.simps(1)
                                       M ide_char in_mono last_in_set mem_Collect_eq)
                                 moreover have NN': "\<Lambda>.elementary_reduction ?N'"
                                   using ** B N'
                                   by (metis Arr.simps(1) Con_implies_Arr(2) Ide.simps(1)
                                       ide_char in_mono list.set_sel(1) mem_Collect_eq)
                                 moreover have "\<Lambda>.Trg ?M = ?M'"
                                 proof -
                                   have 1: "[\<Lambda>.Trg ?M] \<^sup>*\<sim>\<^sup>* [?M']"
                                   proof -
                                     have "[\<Lambda>.Trg ?M] \<^sup>*\<sim>\<^sup>*
                                           [\<Lambda>.Trg (last (M # filter notIde (map \<Lambda>.un_App1 (u # U))))]"
                                     proof -
                                       have "targets (stdz_insert M
                                                       (filter notIde (map \<Lambda>.un_App1 (u # U)))) =
                                             targets (M # filter notIde (map \<Lambda>.un_App1 (u # U)))"
                                         using * A cong_implies_coterminal by blast
                                       moreover
                                       have "[\<Lambda>.Trg (last (M # filter notIde (map \<Lambda>.un_App1 (u # U))))]
                                               \<in> targets (M # filter notIde (map \<Lambda>.un_App1 (u # U)))"
                                         by (metis (no_types, lifting) * A \<Lambda>.Arr_Trg \<Lambda>.Ide_Trg
                                             Arr.simps(2) Arr_append_iff\<^sub>P Arr_iff_Con_self
                                             Con_implies_Arr(2) Ide.simps(1) Ide.simps(2)
                                             Resid_Arr_Ide_ind ide_char append_butlast_last_id
                                             append_self_conv2 \<Lambda>.arr_char in_targets_iff \<Lambda>.ide_char
                                             list.discI)
                                       ultimately show ?thesis
                                         using * A M in_targets_iff
                                         by (metis (no_types, lifting) Con_implies_Arr(1)
                                             con_char prfx_implies_con in_targets_iff)
                                     qed
                                     also have 2: "[\<Lambda>.Trg (last (M # filter notIde
                                                                       (map \<Lambda>.un_App1 (u # U))))] \<^sup>*\<sim>\<^sup>*
                                                   [\<Lambda>.Trg (last (filter notIde
                                                                   (map \<Lambda>.un_App1 (u # U))))]"
                                       by (metis (no_types, lifting) * prfx_transitive
                                           calculation empty_filter_conv last_ConsR list.set_map
                                           mem_Collect_eq subsetI)
                                     also have "[\<Lambda>.Trg (last (filter notIde
                                                                (map \<Lambda>.un_App1 (u # U))))] \<^sup>*\<sim>\<^sup>*
                                                [\<Lambda>.Trg (last (map \<Lambda>.un_App1 (u # U)))]"
                                     proof -
                                       have "map \<Lambda>.un_App1 (u # U) \<^sup>*\<sim>\<^sup>*
                                             filter notIde (map \<Lambda>.un_App1 (u # U))"
                                         by (metis (mono_tags, lifting) * *** Arr_map_un_App1
                                             Std Std_imp_Arr cong_filter_notIde empty_filter_conv
                                             filter_notIde_Ide insert_subset list.discI list.set_map
                                             list.simps(15) mem_Collect_eq subsetI u)
                                       thus ?thesis
                                         by (metis 2 Trg_last_eqI prfx_transitive)
                                     qed
                                     also have "[\<Lambda>.Trg (last (map \<Lambda>.un_App1 (u # U)))] = [?M']"
                                       by (simp add: last_map)
                                     finally show ?thesis by blast
                                   qed
                                   have 3: "\<Lambda>.Trg ?M = \<Lambda>.Trg ?M \\ ?M'"
                                     by (metis (no_types, lifting) 1 * A M Con_implies_Arr(2)
                                         Ide.simps(1) Resid_Arr_Ide_ind Resid_rec(1)
                                         ide_char target_is_ide in_targets_iff list.inject)
                                   also have "... = ?M'"
                                     by (metis (no_types, lifting) 1 4 Arr.simps(2) Con_implies_Arr(2)
                                         Ide.simps(1) Ide.simps(2) MM NN' Resid_Arr_Ide_ind
                                         Resid_rec(1) Src_hd_eqI calculation ide_char
                                         \<Lambda>.Ide_iff_Src_self \<Lambda>.Src_Trg \<Lambda>.arr_char
                                         \<Lambda>.elementary_reduction.simps(4)
                                         \<Lambda>.elementary_reduction_App_iff \<Lambda>.elementary_reduction_is_arr
                                         \<Lambda>.elementary_reduction_not_ide \<Lambda>.lambda.discI(3)
                                         \<Lambda>.lambda.sel(3) list.sel(1))
                                   finally show ?thesis by blast
                                 qed
                                 moreover have "?N = \<Lambda>.Src ?N'"
                                 proof -
                                   have 1: "[\<Lambda>.Src ?N'] \<^sup>*\<sim>\<^sup>* [?N]"
                                   proof -
                                     have "sources (stdz_insert N
                                                      (filter notIde (map \<Lambda>.un_App2 (u # U)))) =
                                           sources [N]"
                                       using ** B
                                       by (metis Con_implies_Arr(2) Ide.simps(1) coinitialE
                                           cong_implies_coinitial ide_char sources_cons)
                                     thus ?thesis
                                       by (metis (no_types, lifting) AppMN ** B \<Lambda>.Ide_Src
                                           MM MN N' NN' \<Lambda>.Trg_Src Arr.simps(1) Arr.simps(2)
                                           Con_implies_Arr(1) Ide.simps(2) con_char ideE ide_char
                                           sources_cons \<Lambda>.arr_char in_targets_iff
                                           \<Lambda>.elementary_reduction.simps(4) \<Lambda>.elementary_reduction_App_iff
                                           \<Lambda>.elementary_reduction_is_arr \<Lambda>.elementary_reduction_not_ide
                                           \<Lambda>.lambda.disc(14) \<Lambda>.lambda.sel(4) last_ConsL list.exhaust_sel
                                           targets_single_Src)
                                   qed
                                   have "\<Lambda>.Src ?N' = \<Lambda>.Src ?N' \\ ?N"
                                     by (metis (no_types, lifting) 1 MN \<Lambda>.Coinitial_iff_Con
                                         \<Lambda>.Ide_Src Arr.simps(2) Ide.simps(1) Ide_implies_Arr
                                         Resid_rec(1) ide_char \<Lambda>.not_arr_null \<Lambda>.null_char
                                         \<Lambda>.resid_Arr_Ide)
                                   also have "... = ?N"
                                     by (metis 1 MN NN' Src_hd_eqI calculation \<Lambda>.Src_Src \<Lambda>.arr_char
                                         \<Lambda>.elementary_reduction_is_arr list.sel(1))
                                   finally show ?thesis by simp
                                 qed
                                 ultimately show ?thesis
                                   using u \<Lambda>.sseq.simps(4)
                                   by (metis (mono_tags, lifting))
                               qed
                               thus ?thesis by blast
                             qed
                           qed
                           thus ?thesis
                             using 4 by presburger
                         qed
                         show "\<not> Ide ((M \<^bold>\<circ> N) # u # U) \<longrightarrow>
                                   stdz_insert (M \<^bold>\<circ> N) (u # U) \<^sup>*\<sim>\<^sup>* (M \<^bold>\<circ> N) # u # U"
                         proof
                           have "stdz_insert (M \<^bold>\<circ> N) (u # U) =
                                 map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
                                     (stdz_insert M (filter notIde (map \<Lambda>.un_App1 (u # U)))) @
                                 map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
                                    (stdz_insert N (filter notIde (map \<Lambda>.un_App2 (u # U))))"
                             using 4 by simp
                           also have "... \<^sup>*\<sim>\<^sup>* map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
                                                  (M # map \<Lambda>.un_App1 (u # U)) @
                                                  map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
                                                      (N # map \<Lambda>.un_App2 (u # U))"
                           proof (intro cong_append)
                             have X: "stdz_insert M (filter notIde (map \<Lambda>.un_App1 (u # U))) \<^sup>*\<sim>\<^sup>*
                                      M # map \<Lambda>.un_App1 (u # U)"
                             proof -
                               have "stdz_insert M (filter notIde (map \<Lambda>.un_App1 (u # U))) \<^sup>*\<sim>\<^sup>*
                                     [M] @ filter notIde (map \<Lambda>.un_App1 (u # U))"
                                 using * A by simp
                               also have "[M] @ filter notIde (map \<Lambda>.un_App1 (u # U)) \<^sup>*\<sim>\<^sup>*
                                          [M] @ map \<Lambda>.un_App1 (u # U)"
                               proof -
                                 have "filter notIde (map \<Lambda>.un_App1 (u # U)) \<^sup>*\<sim>\<^sup>*
                                       map \<Lambda>.un_App1 (u # U)"
                                   using * cong_filter_notIde
                                   by (metis (mono_tags, lifting) *** Arr_map_un_App1 Std
                                       Std_imp_Arr empty_filter_conv filter_notIde_Ide insert_subset
                                       list.discI list.set_map list.simps(15) mem_Collect_eq subsetI u)
                                 moreover have "seq [M] (filter notIde (map \<Lambda>.un_App1 (u # U)))"
                                   by (metis * A Arr.simps(1) Con_implies_Arr(1) append_Cons
                                       append_Nil arr_append_imp_seq arr_char calculation
                                       ide_implies_arr list.discI)
                                 ultimately show ?thesis
                                   using cong_append cong_reflexive by blast
                               qed
                               also have "[M] @ map \<Lambda>.un_App1 (u # U) =
                                          M # map \<Lambda>.un_App1 (u # U)"
                                 by simp
                               finally show ?thesis by blast
                             qed
                             have Y: "stdz_insert N (filter notIde (map \<Lambda>.un_App2 (u # U))) \<^sup>*\<sim>\<^sup>*
                                      N # map \<Lambda>.un_App2 (u # U)"
                             proof -
                               have 5: "stdz_insert N (filter notIde (map \<Lambda>.un_App2 (u # U))) \<^sup>*\<sim>\<^sup>*
                                        [N] @ filter notIde (map \<Lambda>.un_App2 (u # U))"
                                 using ** B by simp
                               also have "[N] @ filter notIde (map \<Lambda>.un_App2 (u # U)) \<^sup>*\<sim>\<^sup>*
                                          [N] @ map \<Lambda>.un_App2 (u # U)"
                               proof -
                                 have "filter notIde (map \<Lambda>.un_App2 (u # U)) \<^sup>*\<sim>\<^sup>*
                                       map \<Lambda>.un_App2 (u # U)"
                                   using ** cong_filter_notIde
                                   by (metis (mono_tags, lifting) *** Arr_map_un_App2 Std
                                       Std_imp_Arr empty_filter_conv filter_notIde_Ide insert_subset
                                       list.discI list.set_map list.simps(15) mem_Collect_eq subsetI u)
                                 moreover have "seq [N] (filter notIde (map \<Lambda>.un_App2 (u # U)))"
                                   by (metis 5 Arr.simps(1) Con_implies_Arr(2) Ide.simps(1)
                                       arr_append_imp_seq arr_char calculation ide_char not_Cons_self2)
                                 ultimately show ?thesis
                                   using cong_append cong_reflexive by blast
                               qed
                               also have "[N] @ map \<Lambda>.un_App2 (u # U) =
                                          N # map \<Lambda>.un_App2 (u # U)"
                                 by simp
                               finally show ?thesis by blast
                             qed
                             show "seq (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
                                            (stdz_insert M (filter notIde (map \<Lambda>.un_App1 (u # U)))))
                                       (map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
                                            (stdz_insert N (filter notIde (map \<Lambda>.un_App2 (u # U)))))"
                               by (metis 4 * ** A B Ide.simps(1) Nil_is_append_conv Nil_is_map_conv
                                   Resid.simps(1) Std_imp_Arr \<open>Std (stdz_insert (M \<^bold>\<circ> N) (u # U))\<close>
                                   arr_append_imp_seq arr_char ide_char)
                             show "map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
                                       (stdz_insert M (filter notIde (map \<Lambda>.un_App1 (u # U)))) \<^sup>*\<sim>\<^sup>*
                                   map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N) (M # map \<Lambda>.un_App1 (u # U))"
                               using X cong_map_App2 MN lambda_calculus.Ide_Src by presburger
                             show "map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
                                       (stdz_insert N (filter notIde (map \<Lambda>.un_App2 (u # U)))) \<^sup>*\<sim>\<^sup>*
                                   map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
                                       (N # map \<Lambda>.un_App2 (u # U))"
                             proof -
                               have "set U \<subseteq> Collect \<Lambda>.Arr \<inter> Collect \<Lambda>.is_App"
                                 using *** Std Std_implies_set_subset_elementary_reduction
                                       \<Lambda>.elementary_reduction_is_arr
                                 by blast
                               hence "\<Lambda>.Ide (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))))"
                                 by (metis inf.boundedE \<Lambda>.Arr.simps(4) \<Lambda>.Ide_Trg
                                     \<Lambda>.lambda.collapse(3) last.simps last_in_set mem_Collect_eq
                                     subset_eq u)
                               thus ?thesis
                                 using Y cong_map_App1 by blast
                             qed
                           qed
                           also have "map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N) (M # map \<Lambda>.un_App1 (u # U)) @
                                        map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
                                            (N # map \<Lambda>.un_App2 (u # U)) \<^sup>*\<sim>\<^sup>* 
                                      [M \<^bold>\<circ> N] @ [u] @ U"
                           proof -
                             have "(map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N) (M # map \<Lambda>.un_App1 (u # U)) @
                                    map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
                                        (N # map \<Lambda>.un_App2 (u # U))) =
                                   ([M \<^bold>\<circ> \<Lambda>.Src N] @
                                      map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N) (map \<Lambda>.un_App1 (u # U))) @
                                   ([\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))) \<^bold>\<circ> N] @
                                      map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
                                          (map \<Lambda>.un_App2 (u # U)))"
                               by simp
                             also have "... = [M \<^bold>\<circ> \<Lambda>.Src N] @
                                                 (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N) (map \<Lambda>.un_App1 (u # U)) @
                                                  map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))))) [N]) @
                                                 map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
                                                     (map \<Lambda>.un_App2 (u # U))"
                               by auto
                             also have "... \<^sup>*\<sim>\<^sup>* [M \<^bold>\<circ> \<Lambda>.Src N] @
                                                  (map (\<Lambda>.App (\<Lambda>.Src (\<Lambda>.un_App1 u))) [N] @
                                                    map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg N) (map \<Lambda>.un_App1 (u # U))) @
                                                    map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
                                                        (map \<Lambda>.un_App2 (u # U))"
                             proof -
                               (*
                                * TODO: (intro congI) does not work because it breaks the expression
                                * down too far, resulting in a false subgoal.
                                *)
                               have "(map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N) (map \<Lambda>.un_App1 (u # U)) @
                                        map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))))) [N]) @
                                       map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
                                           (map \<Lambda>.un_App2 (u # U)) \<^sup>*\<sim>\<^sup>*
                                     (map (\<Lambda>.App (\<Lambda>.Src (\<Lambda>.un_App1 u))) [N] @
                                        map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg N) (map \<Lambda>.un_App1 (u # U))) @
                                        map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
                                                    (map \<Lambda>.un_App2 (u # U))"
                               proof -
                                 have 1: "Arr (map \<Lambda>.un_App1 (u # U))"
                                   using u ***
                                   by (metis Arr_map_un_App1 Std Std_imp_Arr list.discI
                                      mem_Collect_eq set_ConsD subset_code(1))
                                 have "map (\<lambda>X. \<Lambda>.App X (\<Lambda>.Src N)) (map \<Lambda>.un_App1 (u # U)) @
                                           map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))))) [N] \<^sup>*\<sim>\<^sup>*
                                         map (\<Lambda>.App (\<Lambda>.Src (\<Lambda>.un_App1 u))) [N] @
                                           map (\<lambda>X. \<Lambda>.App X (\<Lambda>.Trg N)) (map \<Lambda>.un_App1 (u # U))"
                                 proof -
                                   have "Arr [N]"
                                       using MN by simp
                                   moreover have "\<Lambda>.Trg (last (map \<Lambda>.un_App1 (u # U))) =
                                                  \<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))"
                                     by (simp add: last_map)
                                   ultimately show ?thesis
                                       using 1 orthogonal_App_cong [of "map \<Lambda>.un_App1 (u # U)" "[N]"]
                                       by simp
                                 qed
                                 moreover have "seq (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N) (map \<Lambda>.un_App1 (u # U)) @
                                                     map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))))) [N])
                                                     (map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
                                                          (map \<Lambda>.un_App2 (u # U)))"
                                 proof
                                   show "Arr (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
                                                  (map \<Lambda>.un_App1 (u # U)) @
                                              map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))))) [N])"
                                     by (metis Con_implies_Arr(1) Ide.simps(1) calculation ide_char)
                                   show "Arr (map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
                                                  (map \<Lambda>.un_App2 (u # U)))"
                                     using u ***
                                     by (metis 1 Arr_imp_arr_last Arr_map_App2 Arr_map_un_App2
                                         Std Std_imp_Arr \<Lambda>.Ide_Trg \<Lambda>.arr_char last_map list.discI
                                         mem_Collect_eq set_ConsD subset_code(1))
                                   show "\<Lambda>.Trg (last (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N)
                                                          (map \<Lambda>.un_App1 (u # U)) @
                                                      map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
                                                          [N])) =
                                         \<Lambda>.Src (hd (map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
                                                        (map \<Lambda>.un_App2 (u # U))))"
                                   proof -
                                     have 1: "\<Lambda>.Arr (\<Lambda>.un_App1 u)"
                                       using u \<Lambda>.is_App_def by force
                                     have 2: "U \<noteq> [] \<Longrightarrow> \<Lambda>.Arr (\<Lambda>.un_App1 (last U))"
                                       by (metis *** Arr_imp_arr_last Arr_map_un_App1
                                           \<open>U \<noteq> [] \<Longrightarrow> Arr U\<close> \<Lambda>.arr_char last_map)
                                     have 3: "\<Lambda>.Trg N = \<Lambda>.Src (\<Lambda>.un_App2 u)"
                                       by (metis Trg_last_Src_hd_eqI \<Lambda>.Src.simps(4) \<Lambda>.Trg.simps(3)
                                           \<Lambda>.lambda.collapse(3) \<Lambda>.lambda.inject(3) last_ConsL
                                           list.sel(1) seq u)
                                     show ?thesis
                                       using u *** seq 1 2 3
                                       by (cases "U = []") auto
                                   qed
                                 qed
                                 moreover have "map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
                                                    (map \<Lambda>.un_App2 (u # U)) \<^sup>*\<sim>\<^sup>*
                                                map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
                                                    (map \<Lambda>.un_App2 (u # U))"
                                   using calculation(2) cong_reflexive by blast
                                 ultimately show ?thesis
                                   using cong_append by blast
                               qed
                               moreover have "seq [M \<^bold>\<circ> \<Lambda>.Src N]
                                                  ((map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N) (map \<Lambda>.un_App1 (u # U)) @
                                                    map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))))) [N]) @
                                                   map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
                                                       (map \<Lambda>.un_App2 (u # U)))"
                               proof
                                 show "Arr [M \<^bold>\<circ> \<Lambda>.Src N]"
                                     using MN by simp
                                 show "Arr ((map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N) (map \<Lambda>.un_App1 (u # U)) @
                                               map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))))) [N]) @
                                               map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
                                               (map \<Lambda>.un_App2 (u # U)))"
                                     using MN u seq
                                     by (metis Con_implies_Arr(1) Ide.simps(1) calculation ide_char)
                                 show "\<Lambda>.Trg (last [M \<^bold>\<circ> \<Lambda>.Src N]) =
                                       \<Lambda>.Src (hd ((map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Src N) (map \<Lambda>.un_App1 (u # U)) @
                                                   map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U))))) [N]) @
                                                   map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
                                                       (map \<Lambda>.un_App2 (u # U))))"
                                   using MN u seq seq_char Srcs_simp\<^sub>\<Lambda>\<^sub>P
                                   by (cases u) auto
                               qed
                               ultimately show ?thesis
                                 using cong_append
                                 by (meson Resid_Arr_self ide_char seq_char)
                             qed
                             also have "[M \<^bold>\<circ> \<Lambda>.Src N] @
                                          (map (\<Lambda>.App (\<Lambda>.Src (\<Lambda>.un_App1 u))) [N] @
                                            map (\<lambda>X. \<Lambda>.App X (\<Lambda>.Trg N)) (map \<Lambda>.un_App1 (u # U))) @
                                            map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
                                                (map \<Lambda>.un_App2 (u # U)) =
                                        ([M \<^bold>\<circ> \<Lambda>.Src N] @ [\<Lambda>.Src (\<Lambda>.un_App1 u) \<^bold>\<circ> N]) @
                                          (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg N) (map \<Lambda>.un_App1 (u # U))) @
                                             map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
                                                 (map \<Lambda>.un_App2 (u # U))"
                               by simp
                             also have "... \<^sup>*\<sim>\<^sup>* ([M \<^bold>\<circ> N] @ [u] @ U)"
                             proof -
                               have "[M \<^bold>\<circ> \<Lambda>.Src N] @ [\<Lambda>.Src (\<Lambda>.un_App1 u) \<^bold>\<circ> N] \<^sup>*\<sim>\<^sup>* [M \<^bold>\<circ> N]"
                               proof -
                                 have "\<Lambda>.Src (\<Lambda>.un_App1 u) = \<Lambda>.Trg M"
                                   by (metis Trg_last_Src_hd_eqI \<Lambda>.Src.simps(4) \<Lambda>.Trg.simps(3)
                                       \<Lambda>.lambda.collapse(3) \<Lambda>.lambda.inject(3) last.simps
                                       list.sel(1) seq u)
                                 thus ?thesis
                                   using MN u seq seq_char \<Lambda>.Arr_not_Nil \<Lambda>.resid_Arr_self ide_char
                                         \<Lambda>.Ide_Trg
                                   by simp
                               qed
                               moreover have "map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg N) (map \<Lambda>.un_App1 (u # U)) @
                                                map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
                                                    (map \<Lambda>.un_App2 (u # U)) \<^sup>*\<sim>\<^sup>*
                                              [u] @ U"
                               proof -
                                 have "Arr ([u] @ U)"
                                   by (simp add: Std)
                                 moreover have "set ([u] @ U) \<subseteq> Collect \<Lambda>.is_App"
                                   using *** u by auto
                                 moreover have "\<Lambda>.Src (\<Lambda>.un_App2 (hd ([u] @ U))) = \<Lambda>.Trg N"
                                 proof -
                                   have "\<Lambda>.Ide (\<Lambda>.Trg N)"
                                     using MN lambda_calculus.Ide_Trg by presburger
                                   moreover have "\<Lambda>.Ide (\<Lambda>.Src (\<Lambda>.un_App2 (hd ([u] @ U))))"
                                     by (metis Std Std_implies_set_subset_elementary_reduction
                                         \<Lambda>.Ide_Src \<Lambda>.arr_iff_has_source \<Lambda>.ide_implies_arr
                                         \<open>set ([u] @ U) \<subseteq> Collect \<Lambda>.is_App\<close> append_Cons
                                         \<Lambda>.elementary_reduction_App_iff \<Lambda>.elementary_reduction_is_arr
                                         \<Lambda>.sources_char\<^sub>\<Lambda> list.sel(1) list.set_intros(1)
                                         mem_Collect_eq subset_code(1))
                                   moreover have "\<Lambda>.Src (\<Lambda>.Trg N) =
                                                  \<Lambda>.Src (\<Lambda>.Src (\<Lambda>.un_App2 (hd ([u] @ U))))"
                                   proof -
                                     have "\<Lambda>.Src (\<Lambda>.Trg N) = \<Lambda>.Trg N"
                                       using MN by simp
                                     also have "... = \<Lambda>.Src (\<Lambda>.un_App2 u)"
                                       using u seq seq_char Srcs_simp\<^sub>\<Lambda>\<^sub>P
                                       by (cases u) auto
                                     also have "... = \<Lambda>.Src (\<Lambda>.Src (\<Lambda>.un_App2 (hd ([u] @ U))))"
                                       by (metis \<Lambda>.Ide_iff_Src_self \<Lambda>.Ide_implies_Arr
                                           \<open>\<Lambda>.Ide (\<Lambda>.Src (\<Lambda>.un_App2 (hd ([u] @ U))))\<close>
                                           append_Cons list.sel(1))
                                     finally show ?thesis by blast
                                   qed
                                   ultimately show ?thesis
                                     by (metis \<Lambda>.Ide_iff_Src_self \<Lambda>.Ide_implies_Arr)
                                 qed           
                                 ultimately show ?thesis
                                   using map_App_decomp
                                   by (metis append_Cons append_Nil)
                               qed
                               moreover have "seq ([M \<^bold>\<circ> \<Lambda>.Src N] @ [\<Lambda>.Src (\<Lambda>.un_App1 u) \<^bold>\<circ> N])
                                                  (map (\<lambda>X. X \<^bold>\<circ> \<Lambda>.Trg N) (map \<Lambda>.un_App1 (u # U)) @
                                                   map (\<Lambda>.App (\<Lambda>.Trg (\<Lambda>.un_App1 (last (u # U)))))
                                                       (map \<Lambda>.un_App2 (u # U)))"
                                 using calculation(1-2) cong_respects_seq\<^sub>P seq by auto
                               ultimately show ?thesis
                                 using cong_append by presburger
                             qed
                             finally show ?thesis by blast
                           qed
                           also have "[M \<^bold>\<circ> N] @ [u] @ U = (M \<^bold>\<circ> N) # u # U"
                             by simp
                           finally show "stdz_insert (M \<^bold>\<circ> N) (u # U) \<^sup>*\<sim>\<^sup>* (M \<^bold>\<circ> N) # u # U"
                             by blast
                         qed
                       qed
                     qed
                   qed
                 qed
               qed
             qed
           qed
         qed
       qed
       text \<open>
         The eight remaining subgoals are now trivial consequences of fact \<open>*\<close>.
         Unfortunately, I haven't found a way to discharge them without having to state each
         one of them explicitly.
       \<close>
       show "\<And>N u U. \<lbrakk>\<Lambda>.Ide (\<^bold>\<sharp> \<^bold>\<circ> N) \<Longrightarrow> ?P (hd (u # U)) (tl (u # U));
                       \<lbrakk>\<not> \<Lambda>.Ide (\<^bold>\<sharp> \<^bold>\<circ> N); \<Lambda>.seq (\<^bold>\<sharp> \<^bold>\<circ> N) (hd (u # U));
                        \<Lambda>.contains_head_reduction (\<^bold>\<sharp> \<^bold>\<circ> N);
                        \<Lambda>.Ide ((\<^bold>\<sharp> \<^bold>\<circ> N) \\ \<Lambda>.head_redex (\<^bold>\<sharp> \<^bold>\<circ> N))\<rbrakk>
                          \<Longrightarrow> ?P (hd (u # U)) (tl (u # U));
                       \<lbrakk>\<not> \<Lambda>.Ide (\<^bold>\<sharp> \<^bold>\<circ> N); \<Lambda>.seq (\<^bold>\<sharp> \<^bold>\<circ> N) (hd (u # U));
                        \<Lambda>.contains_head_reduction (\<^bold>\<sharp> \<^bold>\<circ> N);
                        \<not> \<Lambda>.Ide ((\<^bold>\<sharp> \<^bold>\<circ> N) \\ \<Lambda>.head_redex (\<^bold>\<sharp> \<^bold>\<circ> N))\<rbrakk>
                          \<Longrightarrow> ?P ((\<^bold>\<sharp> \<^bold>\<circ> N) \\ \<Lambda>.head_redex (\<^bold>\<sharp> \<^bold>\<circ> N)) (u # U);
                       \<lbrakk>\<not> \<Lambda>.Ide (\<^bold>\<sharp> \<^bold>\<circ> N); \<Lambda>.seq (\<^bold>\<sharp> \<^bold>\<circ> N) (hd (u # U));
                        \<not> \<Lambda>.contains_head_reduction (\<^bold>\<sharp> \<^bold>\<circ> N);
                        \<Lambda>.contains_head_reduction (hd (u # U));
                        \<Lambda>.Ide ((\<^bold>\<sharp> \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (\<^bold>\<sharp> \<^bold>\<circ> N))\<rbrakk>
                          \<Longrightarrow> ?P (\<Lambda>.head_strategy (\<^bold>\<sharp> \<^bold>\<circ> N)) (tl (u # U));
                       \<lbrakk>\<not> \<Lambda>.Ide (\<^bold>\<sharp> \<^bold>\<circ> N); \<Lambda>.seq (\<^bold>\<sharp> \<^bold>\<circ> N) (hd (u # U));
                        \<not> \<Lambda>.contains_head_reduction (\<^bold>\<sharp> \<^bold>\<circ> N);
                        \<Lambda>.contains_head_reduction (hd (u # U));
                        \<not> \<Lambda>.Ide ((\<^bold>\<sharp> \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (\<^bold>\<sharp> \<^bold>\<circ> N))\<rbrakk>
                          \<Longrightarrow> ?P (\<Lambda>.resid (\<^bold>\<sharp> \<^bold>\<circ> N) (\<Lambda>.head_strategy (\<^bold>\<sharp> \<^bold>\<circ> N))) (tl (u # U));
                       \<lbrakk>\<not> \<Lambda>.Ide (\<^bold>\<sharp> \<^bold>\<circ> N); \<Lambda>.seq (\<^bold>\<sharp> \<^bold>\<circ> N) (hd (u # U));
                        \<not> \<Lambda>.contains_head_reduction (\<^bold>\<sharp> \<^bold>\<circ> N);
                        \<not> \<Lambda>.contains_head_reduction (hd (u # U))\<rbrakk>
                          \<Longrightarrow> ?P \<^bold>\<sharp> (filter notIde (map \<Lambda>.un_App1 (u # U)));
                       \<lbrakk>\<not> \<Lambda>.Ide (\<^bold>\<sharp> \<^bold>\<circ> N); \<Lambda>.seq (\<^bold>\<sharp> \<^bold>\<circ> N) (hd (u # U));
                        \<not> \<Lambda>.contains_head_reduction (\<^bold>\<sharp> \<^bold>\<circ> N);
                      \<not> \<Lambda>.contains_head_reduction (hd (u # U))\<rbrakk>
                          \<Longrightarrow> ?P N (filter notIde (map \<Lambda>.un_App2 (u # U)))\<rbrakk>
                     \<Longrightarrow> ?P (\<^bold>\<sharp> \<^bold>\<circ> N) (u # U)"
         using * \<Lambda>.lambda.disc(6) by presburger
       show "\<And>x N u U. \<lbrakk>\<Lambda>.Ide (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> N) \<Longrightarrow> ?P (hd (u # U)) (tl (u # U));
                         \<lbrakk>\<not> \<Lambda>.Ide (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> N); \<Lambda>.seq (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> N) (hd (u # U));
                          \<Lambda>.contains_head_reduction (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> N);
                          \<Lambda>.Ide ((\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> N) \\ \<Lambda>.head_redex (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> N))\<rbrakk>
                            \<Longrightarrow> ?P (hd (u # U)) (tl (u # U));
                         \<lbrakk>\<not> \<Lambda>.Ide (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> N); \<Lambda>.seq (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> N) (hd (u # U));
                          \<Lambda>.contains_head_reduction (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> N);
                          \<not> \<Lambda>.Ide ((\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> N) \\ \<Lambda>.head_redex (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> N))\<rbrakk>
                            \<Longrightarrow> ?P ((\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> N) \\ \<Lambda>.head_redex (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> N)) (u # U);
                         \<lbrakk>\<not> \<Lambda>.Ide (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> N); \<Lambda>.seq (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> N) (hd (u # U));
                          \<not> \<Lambda>.contains_head_reduction (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> N);
                          \<Lambda>.contains_head_reduction (hd (u # U));
                          \<Lambda>.Ide ((\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> N))\<rbrakk>
                            \<Longrightarrow> ?P (\<Lambda>.head_strategy (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> N)) (tl (u # U));
                         \<lbrakk>\<not> \<Lambda>.Ide (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> N); \<Lambda>.seq (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> N) (hd (u # U));
                          \<not> \<Lambda>.contains_head_reduction (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> N);
                          \<Lambda>.contains_head_reduction (hd (u # U));
                          \<not> \<Lambda>.Ide ((\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> N))\<rbrakk>
                            \<Longrightarrow> ?P ((\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> N)) (tl (u # U));
                         \<lbrakk>\<not> \<Lambda>.Ide (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> N); \<Lambda>.seq (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> N) (hd (u # U));
                          \<not> \<Lambda>.contains_head_reduction (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> N);
                          \<not> \<Lambda>.contains_head_reduction (hd (u # U))\<rbrakk>
                            \<Longrightarrow> ?P \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> (filter notIde (map \<Lambda>.un_App1 (u # U)));
                         \<lbrakk>\<not> \<Lambda>.Ide (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> N); \<Lambda>.seq (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> N) (hd (u # U));
                          \<not> \<Lambda>.contains_head_reduction (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> N);
                          \<not> \<Lambda>.contains_head_reduction (hd (u # U))\<rbrakk>
                            \<Longrightarrow> ?P N (filter notIde (map \<Lambda>.un_App2 (u # U)))\<rbrakk>
                     \<Longrightarrow> ?P (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> \<^bold>\<circ> N) (u # U)"
         using * \<Lambda>.lambda.disc(7) by presburger
       show "\<And>M1 M2 N u U. \<lbrakk>\<Lambda>.Ide (M1 \<^bold>\<circ> M2 \<^bold>\<circ> N) \<Longrightarrow> ?P (hd (u # U)) (tl (u # U));
                            \<lbrakk>\<not> \<Lambda>.Ide (M1 \<^bold>\<circ> M2 \<^bold>\<circ> N); \<Lambda>.seq (M1 \<^bold>\<circ> M2 \<^bold>\<circ> N) (hd (u # U));
                             \<Lambda>.contains_head_reduction (M1 \<^bold>\<circ> M2 \<^bold>\<circ> N);
                             \<Lambda>.Ide ((M1 \<^bold>\<circ> M2 \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M1 \<^bold>\<circ> M2 \<^bold>\<circ> N))\<rbrakk>
                               \<Longrightarrow> ?P (hd (u # U)) (tl (u # U));
                            \<lbrakk>\<not> \<Lambda>.Ide (M1 \<^bold>\<circ> M2 \<^bold>\<circ> N); \<Lambda>.seq (M1 \<^bold>\<circ> M2 \<^bold>\<circ> N) (hd (u # U));
                             \<Lambda>.contains_head_reduction (M1 \<^bold>\<circ> M2 \<^bold>\<circ> N);
                             \<not> \<Lambda>.Ide ((M1 \<^bold>\<circ> M2 \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M1 \<^bold>\<circ> M2 \<^bold>\<circ> N))\<rbrakk>
                               \<Longrightarrow> ?P ((M1 \<^bold>\<circ> M2 \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M1 \<^bold>\<circ> M2 \<^bold>\<circ> N)) (u # U);
                            \<lbrakk>\<not> \<Lambda>.Ide (M1 \<^bold>\<circ> M2 \<^bold>\<circ> N); \<Lambda>.seq (M1 \<^bold>\<circ> M2 \<^bold>\<circ> N) (hd (u # U));
                             \<not> \<Lambda>.contains_head_reduction (M1 \<^bold>\<circ> M2 \<^bold>\<circ> N);
                             \<Lambda>.contains_head_reduction (hd (u # U));
                             \<Lambda>.Ide ((M1 \<^bold>\<circ> M2 \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M1 \<^bold>\<circ> M2 \<^bold>\<circ> N))\<rbrakk>
                               \<Longrightarrow> ?P (\<Lambda>.head_strategy (M1 \<^bold>\<circ> M2 \<^bold>\<circ> N)) (tl (u # U));
                            \<lbrakk>\<not> \<Lambda>.Ide (M1 \<^bold>\<circ> M2 \<^bold>\<circ> N); \<Lambda>.seq (M1 \<^bold>\<circ> M2 \<^bold>\<circ> N) (hd (u # U));
                             \<not> \<Lambda>.contains_head_reduction (M1 \<^bold>\<circ> M2 \<^bold>\<circ> N);
                             \<Lambda>.contains_head_reduction (hd (u # U));
                             \<not> \<Lambda>.Ide ((M1 \<^bold>\<circ> M2 \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M1 \<^bold>\<circ> M2 \<^bold>\<circ> N))\<rbrakk>
                               \<Longrightarrow> ?P ((M1 \<^bold>\<circ> M2 \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M1 \<^bold>\<circ> M2 \<^bold>\<circ> N)) (tl (u # U));
                            \<lbrakk>\<not> \<Lambda>.Ide (M1 \<^bold>\<circ> M2 \<^bold>\<circ> N); \<Lambda>.seq (M1 \<^bold>\<circ> M2 \<^bold>\<circ> N) (hd (u # U));
                             \<not> \<Lambda>.contains_head_reduction (M1 \<^bold>\<circ> M2 \<^bold>\<circ> N);
                             \<not> \<Lambda>.contains_head_reduction (hd (u # U))\<rbrakk>
                               \<Longrightarrow> ?P (M1 \<^bold>\<circ> M2) (filter notIde (map \<Lambda>.un_App1 (u # U)));
                            \<lbrakk>\<not> \<Lambda>.Ide (M1 \<^bold>\<circ> M2 \<^bold>\<circ> N); \<Lambda>.seq (M1 \<^bold>\<circ> M2 \<^bold>\<circ> N) (hd (u # U));
                             \<not> \<Lambda>.contains_head_reduction (M1 \<^bold>\<circ> M2 \<^bold>\<circ> N);
                             \<not> \<Lambda>.contains_head_reduction (hd (u # U))\<rbrakk>
                               \<Longrightarrow> ?P N (filter notIde (map \<Lambda>.un_App2 (u # U)))\<rbrakk>
                     \<Longrightarrow> ?P (M1 \<^bold>\<circ> M2 \<^bold>\<circ> N) (u # U)"
          using * \<Lambda>.lambda.disc(9) by presburger
       show "\<And>M1 M2 N u U. \<lbrakk>\<Lambda>.Ide (\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2 \<^bold>\<circ> N) \<Longrightarrow> ?P (hd (u # U)) (tl (u # U));
                            \<lbrakk>\<not> \<Lambda>.Ide (\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2 \<^bold>\<circ> N); \<Lambda>.seq (\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2 \<^bold>\<circ> N) (hd (u # U));
                             \<Lambda>.contains_head_reduction (\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2 \<^bold>\<circ> N);
                             \<Lambda>.Ide ((\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2 \<^bold>\<circ> N) \\ (\<Lambda>.head_redex (\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2 \<^bold>\<circ> N)))\<rbrakk>
                               \<Longrightarrow> ?P (hd (u # U)) (tl (u # U));
                            \<lbrakk>\<not> \<Lambda>.Ide (\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2 \<^bold>\<circ> N); \<Lambda>.seq (\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2 \<^bold>\<circ> N) (hd (u # U));
                             \<Lambda>.contains_head_reduction (\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2 \<^bold>\<circ> N);
                             \<not> \<Lambda>.Ide ((\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2 \<^bold>\<circ> N) \\ (\<Lambda>.head_redex (\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2 \<^bold>\<circ> N)))\<rbrakk>
                               \<Longrightarrow> ?P (\<Lambda>.resid (\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2 \<^bold>\<circ> N) (\<Lambda>.head_redex (\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2 \<^bold>\<circ> N)))
                                      (u # U);
                            \<lbrakk>\<not> \<Lambda>.Ide (\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2 \<^bold>\<circ> N); \<Lambda>.seq (\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2 \<^bold>\<circ> N) (hd (u # U));
                             \<not> \<Lambda>.contains_head_reduction (\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2 \<^bold>\<circ> N);
                             \<Lambda>.contains_head_reduction (hd (u # U));
                             \<Lambda>.Ide ((\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2 \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2 \<^bold>\<circ> N))\<rbrakk>
                               \<Longrightarrow> ?P (\<Lambda>.head_strategy (\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2 \<^bold>\<circ> N)) (tl (u # U));
                            \<lbrakk>\<not> \<Lambda>.Ide (\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2 \<^bold>\<circ> N); \<Lambda>.seq (\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2 \<^bold>\<circ> N) (hd (u # U));
                             \<not> \<Lambda>.contains_head_reduction (\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2 \<^bold>\<circ> N);
                             \<Lambda>.contains_head_reduction (hd (u # U));
                             \<not> \<Lambda>.Ide ((\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2 \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2 \<^bold>\<circ> N))\<rbrakk>
                               \<Longrightarrow> ?P ((\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2 \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2 \<^bold>\<circ> N))
                                      (tl (u # U));
                            \<lbrakk>\<not> \<Lambda>.Ide (\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2 \<^bold>\<circ> N); \<Lambda>.seq (\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2 \<^bold>\<circ> N) (hd (u # U));
                             \<not> \<Lambda>.contains_head_reduction (\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2 \<^bold>\<circ> N);
                             \<not> \<Lambda>.contains_head_reduction (hd (u # U))\<rbrakk>
                               \<Longrightarrow> ?P (\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2) (filter notIde (map \<Lambda>.un_App1 (u # U)));
                            \<lbrakk>\<not> \<Lambda>.Ide (\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2 \<^bold>\<circ> N); \<Lambda>.seq (\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2 \<^bold>\<circ> N) (hd (u # U));
                             \<not> \<Lambda>.contains_head_reduction (\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2 \<^bold>\<circ> N);
                             \<not> \<Lambda>.contains_head_reduction (hd (u # U))\<rbrakk>
                               \<Longrightarrow> ?P N (filter notIde (map \<Lambda>.un_App2 (u # U)))\<rbrakk>
                     \<Longrightarrow> ?P (\<^bold>\<lambda>\<^bold>[M1\<^bold>] \<^bold>\<Zspot> M2 \<^bold>\<circ> N) (u # U)"
          using * \<Lambda>.lambda.disc(10) by presburger
       show "\<And>M N U. \<lbrakk>\<Lambda>.Ide (M \<^bold>\<circ> N) \<Longrightarrow> ?P (hd (\<^bold>\<sharp> # U)) (tl (\<^bold>\<sharp> # U));
                      \<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N); \<Lambda>.seq (M \<^bold>\<circ> N) (hd (\<^bold>\<sharp> # U));
                       \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
                       \<Lambda>.Ide ((M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N))\<rbrakk>
                         \<Longrightarrow> ?P (hd (\<^bold>\<sharp> # U)) (tl (\<^bold>\<sharp> # U));
                      \<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N); \<Lambda>.seq (M \<^bold>\<circ> N) (hd (\<^bold>\<sharp> # U));
                       \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
                       \<not> \<Lambda>.Ide ((M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N))\<rbrakk>
                         \<Longrightarrow> ?P ((M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N)) (\<^bold>\<sharp> # U);
                      \<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N); \<Lambda>.seq (M \<^bold>\<circ> N) (hd (\<^bold>\<sharp> # U));
                       \<not> \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
                       \<Lambda>.contains_head_reduction (hd (\<^bold>\<sharp> # U));
                       \<Lambda>.Ide (\<Lambda>.resid (M \<^bold>\<circ> N) (\<Lambda>.head_strategy (M \<^bold>\<circ> N)))\<rbrakk>
                         \<Longrightarrow> ?P (\<Lambda>.head_strategy (M \<^bold>\<circ> N)) (tl (\<^bold>\<sharp> # U));
                      \<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N); \<Lambda>.seq (M \<^bold>\<circ> N) (hd (\<^bold>\<sharp> # U));
                       \<not> \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
                       \<Lambda>.contains_head_reduction (hd (\<^bold>\<sharp> # U));
                       \<not> \<Lambda>.Ide ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N))\<rbrakk>
                         \<Longrightarrow> ?P ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N)) (tl (\<^bold>\<sharp> # U));
                      \<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N); \<Lambda>.seq (M \<^bold>\<circ> N) (hd (\<^bold>\<sharp> # U));
                       \<not> \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
                       \<not> \<Lambda>.contains_head_reduction (hd (\<^bold>\<sharp> # U))\<rbrakk>
                         \<Longrightarrow> ?P M (filter notIde (map \<Lambda>.un_App1 (\<^bold>\<sharp> # U)));
                      \<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N); \<Lambda>.seq (M \<^bold>\<circ> N) (hd (\<^bold>\<sharp> # U));
                       \<not> \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
                       \<not> \<Lambda>.contains_head_reduction (hd (\<^bold>\<sharp> # U))\<rbrakk>
                         \<Longrightarrow> ?P N (filter notIde (map \<Lambda>.un_App2 (\<^bold>\<sharp> # U)))\<rbrakk>
                    \<Longrightarrow> ?P (M \<^bold>\<circ> N) (\<^bold>\<sharp> # U)"
         using * \<Lambda>.lambda.disc(16) by presburger
       show "\<And>M N x U. \<lbrakk>\<Lambda>.Ide (M \<^bold>\<circ> N) \<Longrightarrow> ?P (hd (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> # U)) (tl (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> # U));
                         \<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N); \<Lambda>.seq (M \<^bold>\<circ> N) (hd (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> # U));
                          \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
                          \<Lambda>.Ide ((M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N))\<rbrakk>
                            \<Longrightarrow> ?P (hd (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> # U)) (tl (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> # U));
                         \<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N); \<Lambda>.seq (M \<^bold>\<circ> N) (hd (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> # U));
                          \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
                          \<not> \<Lambda>.Ide ((M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N))\<rbrakk>
                            \<Longrightarrow> ?P ((M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N)) (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> # U);
                         \<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N); \<Lambda>.seq (M \<^bold>\<circ> N) (hd (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> # U));
                          \<not> \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
                          \<Lambda>.contains_head_reduction (hd (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> # U));
                          \<Lambda>.Ide ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N))\<rbrakk>
                            \<Longrightarrow> ?P (\<Lambda>.head_strategy (M \<^bold>\<circ> N)) (tl (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> # U));
                         \<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N); \<Lambda>.seq (M \<^bold>\<circ> N) (hd (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> # U));
                          \<not> \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
                          \<Lambda>.contains_head_reduction (hd (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> # U));
                          \<not> \<Lambda>.Ide ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N))\<rbrakk>
                            \<Longrightarrow> ?P ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N)) (tl (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> # U));
                         \<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N); \<Lambda>.seq (M \<^bold>\<circ> N) (hd (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> # U));
                          \<not> \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
                          \<not> \<Lambda>.contains_head_reduction (hd (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> # U))\<rbrakk>
                            \<Longrightarrow> ?P M (filter notIde (map \<Lambda>.un_App1 (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> # U)));
                         \<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N); \<Lambda>.seq (M \<^bold>\<circ> N) (hd (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> # U));
                          \<not> \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
                          \<not> \<Lambda>.contains_head_reduction (hd (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> # U))\<rbrakk>
                            \<Longrightarrow> ?P N (filter notIde (map \<Lambda>.un_App2 (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> # U)))\<rbrakk>
                    \<Longrightarrow> ?P (M \<^bold>\<circ> N) (\<^bold>\<guillemotleft>x\<^bold>\<guillemotright> # U)"
         using * \<Lambda>.lambda.disc(17) by presburger
       show "\<And>M N P U. \<lbrakk>\<Lambda>.Ide (M \<^bold>\<circ> N) \<Longrightarrow> ?P (hd (\<^bold>\<lambda>\<^bold>[P\<^bold>] # U)) (tl (\<^bold>\<lambda>\<^bold>[P\<^bold>] # U));
                         \<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N); \<Lambda>.seq (M \<^bold>\<circ> N) (hd (\<^bold>\<lambda>\<^bold>[P\<^bold>] # U));
                          \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
                          \<Lambda>.Ide ((M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N))\<rbrakk>
                            \<Longrightarrow> ?P (hd (\<^bold>\<lambda>\<^bold>[P\<^bold>] # U)) (tl (\<^bold>\<lambda>\<^bold>[P\<^bold>] # U));
                         \<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N); \<Lambda>.seq (M \<^bold>\<circ> N) (hd (\<^bold>\<lambda>\<^bold>[P\<^bold>] # U));
                          \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
                          \<not> \<Lambda>.Ide ((M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N))\<rbrakk>
                            \<Longrightarrow> ?P ((M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N)) (\<^bold>\<lambda>\<^bold>[P\<^bold>] # U);
                         \<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N); \<Lambda>.seq (M \<^bold>\<circ> N) (hd (\<^bold>\<lambda>\<^bold>[P\<^bold>] # U));
                          \<not> \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
                          \<Lambda>.contains_head_reduction (hd (\<^bold>\<lambda>\<^bold>[P\<^bold>] # U));
                          \<Lambda>.Ide ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N))\<rbrakk>
                             \<Longrightarrow> ?P (\<Lambda>.head_strategy (M \<^bold>\<circ> N)) (tl (\<^bold>\<lambda>\<^bold>[P\<^bold>] # U));
                         \<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N); \<Lambda>.seq (M \<^bold>\<circ> N) (hd (\<^bold>\<lambda>\<^bold>[P\<^bold>] # U));
                          \<not> \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
                          \<Lambda>.contains_head_reduction (hd (\<^bold>\<lambda>\<^bold>[P\<^bold>] # U));
                          \<not> \<Lambda>.Ide ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N))\<rbrakk>
                             \<Longrightarrow> ?P (\<Lambda>.resid (M \<^bold>\<circ> N) (\<Lambda>.head_strategy (M \<^bold>\<circ> N))) (tl (\<^bold>\<lambda>\<^bold>[P\<^bold>] # U));
                         \<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N); \<Lambda>.seq (M \<^bold>\<circ> N) (hd (\<^bold>\<lambda>\<^bold>[P\<^bold>] # U));
                          \<not> \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
                          \<not> \<Lambda>.contains_head_reduction (hd (\<^bold>\<lambda>\<^bold>[P\<^bold>] # U))\<rbrakk>
                             \<Longrightarrow> ?P M (filter notIde (map \<Lambda>.un_App1 (\<^bold>\<lambda>\<^bold>[P\<^bold>] # U)));
                         \<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N); \<Lambda>.seq (M \<^bold>\<circ> N) (hd (\<^bold>\<lambda>\<^bold>[P\<^bold>] # U));
                          \<not> \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
                          \<not> \<Lambda>.contains_head_reduction (hd (\<^bold>\<lambda>\<^bold>[P\<^bold>] # U))\<rbrakk>
                             \<Longrightarrow> ?P N (filter notIde (map \<Lambda>.un_App2 (\<^bold>\<lambda>\<^bold>[P\<^bold>] # U)))\<rbrakk>
                   \<Longrightarrow> ?P (M \<^bold>\<circ> N) (\<^bold>\<lambda>\<^bold>[P\<^bold>] # U)"
         using * \<Lambda>.lambda.disc(18) by presburger
       show "\<And>M N P1 P2 U. \<lbrakk>\<Lambda>.Ide (M \<^bold>\<circ> N)
                              \<Longrightarrow> ?P (hd ((P1 \<^bold>\<circ> P2) # U)) (tl ((P1 \<^bold>\<circ> P2) # U));
                            \<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N); \<Lambda>.seq (M \<^bold>\<circ> N) (hd ((P1 \<^bold>\<circ> P2) # U));
                             \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
                             \<Lambda>.Ide ((M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N))\<rbrakk>
                               \<Longrightarrow> ?P (hd ((P1 \<^bold>\<circ> P2) # U)) (tl((P1 \<^bold>\<circ> P2) # U));
                            \<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N); \<Lambda>.seq (M \<^bold>\<circ> N) (hd ((P1 \<^bold>\<circ> P2) # U));
                             \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
                             \<not> \<Lambda>.Ide ((M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N))\<rbrakk>
                               \<Longrightarrow> ?P ((M \<^bold>\<circ> N) \\ \<Lambda>.head_redex (M \<^bold>\<circ> N)) ((P1 \<^bold>\<circ> P2) # U);
                            \<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N); \<Lambda>.seq (M \<^bold>\<circ> N) (hd ((P1 \<^bold>\<circ> P2) # U));
                             \<not> \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
                             \<Lambda>.contains_head_reduction (hd ((P1 \<^bold>\<circ> P2) # U));
                             \<Lambda>.Ide ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N))\<rbrakk>
                               \<Longrightarrow> ?P (\<Lambda>.head_strategy (M \<^bold>\<circ> N)) (tl ((P1 \<^bold>\<circ> P2) # U));
                            \<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N); \<Lambda>.seq (M \<^bold>\<circ> N) (hd ((P1 \<^bold>\<circ> P2) # U));
                             \<not> \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
                             \<Lambda>.contains_head_reduction (hd ((P1 \<^bold>\<circ> P2) # U));
                             \<not> \<Lambda>.Ide ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N))\<rbrakk>
                               \<Longrightarrow> ?P ((M \<^bold>\<circ> N) \\ \<Lambda>.head_strategy (M \<^bold>\<circ> N)) (tl ((P1 \<^bold>\<circ> P2) # U));
                            \<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N); \<Lambda>.seq (M \<^bold>\<circ> N) (hd ((P1 \<^bold>\<circ> P2) # U));
                             \<not> \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
                             \<not> \<Lambda>.contains_head_reduction (hd ((P1 \<^bold>\<circ> P2) # U))\<rbrakk>
                               \<Longrightarrow> ?P M (filter notIde (map \<Lambda>.un_App1 ((P1 \<^bold>\<circ> P2) # U)));
                            \<lbrakk>\<not> \<Lambda>.Ide (M \<^bold>\<circ> N); \<Lambda>.seq (M \<^bold>\<circ> N) (hd ((P1 \<^bold>\<circ> P2) # U));
                             \<not> \<Lambda>.contains_head_reduction (M \<^bold>\<circ> N);
                             \<not> \<Lambda>.contains_head_reduction (hd ((P1 \<^bold>\<circ> P2) # U))\<rbrakk>
                               \<Longrightarrow> ?P N (filter notIde (map \<Lambda>.un_App2 ((P1 \<^bold>\<circ> P2) # U)))\<rbrakk>
                   \<Longrightarrow> ?P (M \<^bold>\<circ> N) ((P1 \<^bold>\<circ> P2) # U)"
         using * \<Lambda>.lambda.disc(19) by presburger
     qed
 
     subsubsection "The Standardization Theorem"
 
     text \<open>
       Using the function \<open>standardize\<close>, we can now prove the Standardization Theorem.
       There is still a little bit more work to do, because we have to deal with various
       cases in which the reduction path to be standardized is empty or consists
       entirely of identities.
     \<close>
 
     theorem standardization_theorem:
     shows "Arr T \<Longrightarrow> Std (standardize T) \<and> (Ide T \<longrightarrow> standardize T = []) \<and>
                      (\<not> Ide T \<longrightarrow> cong (standardize T) T)"
     proof (induct T)
       show "Arr [] \<Longrightarrow> Std (standardize []) \<and> (Ide [] \<longrightarrow> standardize [] = []) \<and>
                        (\<not> Ide [] \<longrightarrow> cong (standardize []) [])"
         by simp
       fix t T
       assume ind: "Arr T \<Longrightarrow> Std (standardize T) \<and> (Ide T \<longrightarrow> standardize T = []) \<and>
                              (\<not> Ide T \<longrightarrow> cong (standardize T) T)"
       assume tT: "Arr (t # T)"
       have t: "\<Lambda>.Arr t"
         using tT Arr_imp_arr_hd by force
       show "Std (standardize (t # T)) \<and> (Ide (t # T) \<longrightarrow> standardize (t # T) = []) \<and>
             (\<not> Ide (t # T) \<longrightarrow> cong (standardize (t # T)) (t # T))"
       proof (cases "T = []")
         show "T = [] \<Longrightarrow> ?thesis"
           using t tT Ide_iff_standard_development_empty Std_standard_development
                 cong_standard_development
           by simp
         assume 0: "T \<noteq> []"
         hence T: "Arr T"
           using tT
           by (metis Arr_imp_Arr_tl list.sel(3))
         show ?thesis
         proof (intro conjI)
           show "Std (standardize (t # T))"
           proof -
             have 1: "\<not> Ide T \<Longrightarrow> seq [t] (standardize T)"
               using t T ind 0 ide_char Con_implies_Arr(1)
               apply (intro seqI\<^sub>\<Lambda>\<^sub>P)
                 apply simp
                apply (metis Con_implies_Arr(1) Ide.simps(1) ide_char)
               by (metis Src_hd_eqI Trg_last_Src_hd_eqI \<open>T \<noteq> []\<close> append_Cons arrI\<^sub>P
                         arr_append_imp_seq list.distinct(1) self_append_conv2 tT)
             show ?thesis
               using T 1 ind Std_standard_development stdz_insert_correctness by auto
           qed
           show "Ide (t # T) \<longrightarrow> standardize (t # T) = []"
             using Ide_consE Ide_iff_standard_development_empty Ide_implies_Arr ind
                   \<Lambda>.Ide_implies_Arr \<Lambda>.ide_char
             by (metis list.sel(1,3) standardize.simps(1-2) stdz_insert.simps(1))
           show "\<not> Ide (t # T) \<longrightarrow> standardize (t # T) \<^sup>*\<sim>\<^sup>* t # T"
           proof
             assume 1: "\<not> Ide (t # T)"
             show "standardize (t # T) \<^sup>*\<sim>\<^sup>* t # T"
             proof (cases "\<Lambda>.Ide t")
               assume t: "\<Lambda>.Ide t"
               have 2: "\<not> Ide T"
                 using 1 t tT by fastforce
               have "standardize (t # T) = stdz_insert t (standardize T)"
                 by simp
               also have "... \<^sup>*\<sim>\<^sup>* t # T"
               proof -
                 have 3: "Std (standardize T) \<and> standardize T \<^sup>*\<sim>\<^sup>* T"
                   using T 2 ind by blast
                 have "stdz_insert t (standardize T) =
                        stdz_insert (hd (standardize T)) (tl (standardize T))"
                 proof -
                   have "seq [t] (standardize T)"
                     using 0 2 tT ind
                     by (metis Arr.elims(2) Con_imp_eq_Srcs Con_implies_Arr(1) Ide.simps(1-2)
                         Ide_implies_Arr Trgs.simps(2) ide_char \<Lambda>.ide_char list.inject
                         seq_char seq_implies_Trgs_eq_Srcs t)
                   thus ?thesis
                     using t 3 stdz_insert_Ide_Std by blast
                 qed
                 also have "...  \<^sup>*\<sim>\<^sup>* hd (standardize T) # tl (standardize T)"
                 proof -
                   have "\<not> Ide (standardize T)"
                     using 2 3 ide_backward_stable ide_char by blast
                   moreover have "tl (standardize T) \<noteq> [] \<Longrightarrow>
                                    seq [hd (standardize T)] (tl (standardize T)) \<and>
                                    Std (tl (standardize T))"
                     by (metis 3 Std_consE Std_imp_Arr append.left_neutral append_Cons
                         arr_append_imp_seq arr_char hd_Cons_tl list.discI tl_Nil)
                   ultimately show ?thesis
                     by (metis "2" Ide.simps(2) Resid.simps(1) Std_consE T cong_standard_development
                         ide_char ind \<Lambda>.ide_char list.exhaust_sel stdz_insert.simps(1)
                         stdz_insert_correctness)
                 qed
                 also have "hd (standardize T) # tl (standardize T) = standardize T"
                   by (metis 3 Arr.simps(1) Con_implies_Arr(2) Ide.simps(1) ide_char
                       list.exhaust_sel)
                 also have "standardize T \<^sup>*\<sim>\<^sup>* T"
                   using 3 by simp
                 also have "T \<^sup>*\<sim>\<^sup>* t # T"
                   using 0 t tT arr_append_imp_seq arr_char cong_cons_ideI(2) by simp
                 finally show ?thesis by blast
               qed
               thus ?thesis by auto
               next
               assume t: "\<not> \<Lambda>.Ide t"
               show ?thesis
               proof (cases "Ide T")
                 assume T: "Ide T"
                 have "standardize (t # T) = standard_development t"
                   using t T Ide_implies_Arr ind by simp
                 also have "... \<^sup>*\<sim>\<^sup>* [t]"
                   using t T tT cong_standard_development [of t] by blast
                 also have "[t] \<^sup>*\<sim>\<^sup>* [t] @ T"
                   using t T tT cong_append_ideI(4) [of "[t]" T]
                   by (simp add: 0 arrI\<^sub>P arr_append_imp_seq ide_char)
                 finally show ?thesis by auto
                 next
                 assume T: "\<not> Ide T"
                 have 1: "Std (standardize T) \<and> standardize T \<^sup>*\<sim>\<^sup>* T"
                   using T \<open>Arr T\<close> ind by blast
                 have 2: "seq [t] (standardize T)"
                   by (metis 0 Arr.simps(2) Arr.simps(3) Con_imp_eq_Srcs Con_implies_Arr(2)
                       Ide.elims(3) Ide.simps(1) T Trgs.simps(2) ide_char ind
                       seq_char seq_implies_Trgs_eq_Srcs tT)
                 have "stdz_insert t (standardize T) \<^sup>*\<sim>\<^sup>* t # standardize T"
                   using t 1 2 stdz_insert_correctness [of t "standardize T"] by blast
                 also have "t # standardize T \<^sup>*\<sim>\<^sup>* t # T"
                   using 1 2
                   by (meson Arr.simps(2) \<Lambda>.prfx_reflexive cong_cons seq_char)
                 finally show ?thesis by auto
               qed
             qed
           qed
         qed
       qed
     qed
 
     subsubsection "The Leftmost Reduction Theorem"
 
     text \<open>
       In this section we prove the Leftmost Reduction Theorem, which states that
       leftmost reduction is a normalizing strategy.
 
       We first show that if a standard reduction path reaches a normal form,
       then the path must be the one produced by following the leftmost reduction strategy.
       This is because, in a standard reduction path, once a leftmost redex is skipped,
       all subsequent reductions occur ``to the right of it'', hence they are all non-leftmost
       reductions that do not contract the skipped redex, which remains in the leftmost position.
 
       The Leftmost Reduction Theorem then follows from the Standardization Theorem.
       If a term is normalizable, there is a reduction path from that term to a normal form.
       By the Standardization Theorem we may as well assume that path is standard.
       But a standard reduction path to a normal form is the path generated by following
       the leftmost reduction strategy, hence leftmost reduction reaches a normal form after
       a finite number of steps.
     \<close>
 
     lemma sseq_reflects_leftmost_reduction:
     assumes "\<Lambda>.sseq t u" and "\<Lambda>.is_leftmost_reduction u"
     shows "\<Lambda>.is_leftmost_reduction t"
     proof -
       have *: "\<And>u. u = \<Lambda>.leftmost_strategy (\<Lambda>.Src t) \\ t \<Longrightarrow> \<not> \<Lambda>.sseq t u" for t
       proof (induct t)
         show "\<And>u. \<not> \<Lambda>.sseq \<^bold>\<sharp> u"
           using \<Lambda>.sseq_imp_seq by blast
         show "\<And>x u. \<not> \<Lambda>.sseq \<^bold>\<guillemotleft>x\<^bold>\<guillemotright> u"
           using \<Lambda>.elementary_reduction.simps(2) \<Lambda>.sseq_imp_elementary_reduction1 by blast
         show "\<And>t u. \<lbrakk>\<And>u. u = \<Lambda>.leftmost_strategy (\<Lambda>.Src t) \\ t \<Longrightarrow> \<not> \<Lambda>.sseq t u;
                       u = \<Lambda>.leftmost_strategy (\<Lambda>.Src \<^bold>\<lambda>\<^bold>[t\<^bold>]) \\ \<^bold>\<lambda>\<^bold>[t\<^bold>]\<rbrakk>
                         \<Longrightarrow> \<not> \<Lambda>.sseq \<^bold>\<lambda>\<^bold>[t\<^bold>] u"
           by auto
         show "\<And>t1 t2 u. \<lbrakk>\<And>u. u = \<Lambda>.leftmost_strategy (\<Lambda>.Src t1) \\ t1 \<Longrightarrow> \<not> \<Lambda>.sseq t1 u;
                          \<And>u. u = \<Lambda>.leftmost_strategy (\<Lambda>.Src t2) \\ t2 \<Longrightarrow> \<not> \<Lambda>.sseq t2 u;
                          u = \<Lambda>.leftmost_strategy (\<Lambda>.Src (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)) \\ (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)\<rbrakk>
                            \<Longrightarrow> \<not> \<Lambda>.sseq (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2) u"
           apply simp
           by (metis \<Lambda>.sseq_imp_elementary_reduction2 \<Lambda>.Coinitial_iff_Con \<Lambda>.Ide_Src
               \<Lambda>.Ide_Subst \<Lambda>.elementary_reduction_not_ide \<Lambda>.ide_char \<Lambda>.resid_Ide_Arr)
         show "\<And>t1 t2. \<lbrakk>\<And>u. u = \<Lambda>.leftmost_strategy (\<Lambda>.Src t1) \\ t1 \<Longrightarrow> \<not> \<Lambda>.sseq t1 u;
                        \<And>u. u = \<Lambda>.leftmost_strategy (\<Lambda>.Src t2) \\ t2 \<Longrightarrow> \<not> \<Lambda>.sseq t2 u;
                        u = \<Lambda>.leftmost_strategy (\<Lambda>.Src (\<Lambda>.App t1 t2)) \\ \<Lambda>.App t1 t2\<rbrakk>
                          \<Longrightarrow> \<not> \<Lambda>.sseq (\<Lambda>.App t1 t2) u" for u
           apply (cases u)
               apply simp_all
              apply (metis \<Lambda>.elementary_reduction.simps(2) \<Lambda>.sseq_imp_elementary_reduction2)
             apply (metis \<Lambda>.Src.simps(3) \<Lambda>.Src_resid \<Lambda>.Trg.simps(3) \<Lambda>.lambda.distinct(15)
                          \<Lambda>.lambda.distinct(3))
         proof -
           show "\<And>t1 t2 u1 u2.
                   \<lbrakk>\<not> \<Lambda>.sseq t1 (\<Lambda>.leftmost_strategy (\<Lambda>.Src t1) \\ t1);
                    \<not> \<Lambda>.sseq t2 (\<Lambda>.leftmost_strategy (\<Lambda>.Src t2) \\ t2);
                    \<^bold>\<lambda>\<^bold>[u1\<^bold>] \<^bold>\<Zspot> u2 = \<Lambda>.leftmost_strategy (\<Lambda>.App (\<Lambda>.Src t1) (\<Lambda>.Src t2)) \\ \<Lambda>.App t1 t2;
                    u = \<Lambda>.leftmost_strategy (\<Lambda>.App (\<Lambda>.Src t1) (\<Lambda>.Src t2)) \\ \<Lambda>.App t1 t2\<rbrakk>
                      \<Longrightarrow> \<not> \<Lambda>.sseq (\<Lambda>.App t1 t2)
                                   (\<Lambda>.leftmost_strategy (\<Lambda>.App (\<Lambda>.Src t1) (\<Lambda>.Src t2)) \\ \<Lambda>.App t1 t2)"
-            by (metis \<Lambda>.sseq_imp_elementary_reduction1 \<Lambda>.Arr.simps(5) \<Lambda>.Arr_resid_ind
+            by (metis \<Lambda>.sseq_imp_elementary_reduction1 \<Lambda>.Arr.simps(5) \<Lambda>.Arr_resid
                       \<Lambda>.Coinitial_iff_Con \<Lambda>.Ide.simps(5) \<Lambda>.Ide_iff_Src_self \<Lambda>.Src.simps(4)
                       \<Lambda>.Src_resid \<Lambda>.contains_head_reduction.simps(8) \<Lambda>.is_head_reduction_if
                       \<Lambda>.lambda.discI(3) \<Lambda>.lambda.distinct(7)
                       \<Lambda>.leftmost_strategy_selects_head_reduction \<Lambda>.resid_Arr_self
                       \<Lambda>.sseq_preserves_App_and_no_head_reduction)
           show "\<And>u1 u2.
                   \<lbrakk>\<not> \<Lambda>.sseq t1 (\<Lambda>.leftmost_strategy (\<Lambda>.Src t1) \\ t1);
                    \<not> \<Lambda>.sseq t2 (\<Lambda>.leftmost_strategy (\<Lambda>.Src t2) \\ t2);
                    \<Lambda>.App u1 u2 = \<Lambda>.leftmost_strategy (\<Lambda>.App (\<Lambda>.Src t1) (\<Lambda>.Src t2)) \\ \<Lambda>.App t1 t2;
                    u = \<Lambda>.leftmost_strategy (\<Lambda>.App (\<Lambda>.Src t1) (\<Lambda>.Src t2)) \\ \<Lambda>.App t1 t2\<rbrakk>
                      \<Longrightarrow> \<not> \<Lambda>.sseq (\<Lambda>.App t1 t2)
                                   (\<Lambda>.leftmost_strategy (\<Lambda>.App (\<Lambda>.Src t1) (\<Lambda>.Src t2)) \\ \<Lambda>.App t1 t2)"
            for t1 t2
             apply (cases "\<not> \<Lambda>.Arr t1")
              apply simp_all
              apply (meson \<Lambda>.Arr.simps(4) \<Lambda>.seq_char \<Lambda>.sseq_imp_seq)
             apply (cases "\<not> \<Lambda>.Arr t2")
              apply simp_all
              apply (meson \<Lambda>.Arr.simps(4) \<Lambda>.seq_char \<Lambda>.sseq_imp_seq)
             using \<Lambda>.Arr_not_Nil
             apply (cases t1)
                 apply simp_all
             using \<Lambda>.NF_iff_has_no_redex \<Lambda>.has_redex_iff_not_Ide_leftmost_strategy
                   \<Lambda>.Ide_iff_Src_self \<Lambda>.Ide_iff_Trg_self
                   \<Lambda>.NF_def \<Lambda>.elementary_reduction_not_ide \<Lambda>.eq_Ide_are_cong
                   \<Lambda>.leftmost_strategy_is_reduction_strategy \<Lambda>.reduction_strategy_def
                   \<Lambda>.resid_Arr_Src
              apply simp
              apply (metis \<Lambda>.Arr.simps(4) \<Lambda>.Ide.simps(4) \<Lambda>.Ide_Trg \<Lambda>.Src.simps(4)
                           \<Lambda>.sseq_imp_elementary_reduction2)
             by (metis \<Lambda>.Ide_Trg \<Lambda>.elementary_reduction_not_ide \<Lambda>.ide_char)
         qed
       qed
       have "t \<noteq> \<Lambda>.leftmost_strategy (\<Lambda>.Src t) \<Longrightarrow> False"
       proof -
         assume 1: "t \<noteq> \<Lambda>.leftmost_strategy (\<Lambda>.Src t)"
         have 2: "\<not> \<Lambda>.Ide (\<Lambda>.leftmost_strategy (\<Lambda>.Src t))"
           by (meson assms(1) \<Lambda>.NF_def \<Lambda>.NF_iff_has_no_redex \<Lambda>.arr_char
               \<Lambda>.elementary_reduction_is_arr \<Lambda>.elementary_reduction_not_ide
               \<Lambda>.has_redex_iff_not_Ide_leftmost_strategy \<Lambda>.ide_char
               \<Lambda>.sseq_imp_elementary_reduction1)
         have "\<Lambda>.is_leftmost_reduction (\<Lambda>.leftmost_strategy (\<Lambda>.Src t) \\ t)"
         proof -
           have "\<Lambda>.is_leftmost_reduction (\<Lambda>.leftmost_strategy (\<Lambda>.Src t))"
             by (metis assms(1) 2 \<Lambda>.Ide_Src \<Lambda>.Ide_iff_Src_self \<Lambda>.arr_char
                 \<Lambda>.elementary_reduction_is_arr \<Lambda>.elementary_reduction_leftmost_strategy
                 \<Lambda>.is_leftmost_reduction_def \<Lambda>.leftmost_strategy_is_reduction_strategy
                 \<Lambda>.reduction_strategy_def \<Lambda>.sseq_imp_elementary_reduction1)
           moreover have 3: "\<Lambda>.elementary_reduction t"
             using assms \<Lambda>.sseq_imp_elementary_reduction1 by simp
           moreover have "\<not> \<Lambda>.is_leftmost_reduction t"
             using 1 \<Lambda>.is_leftmost_reduction_def by auto
           moreover have "\<Lambda>.coinitial (\<Lambda>.leftmost_strategy (\<Lambda>.Src t)) t"
             using 3 \<Lambda>.leftmost_strategy_is_reduction_strategy \<Lambda>.reduction_strategy_def
                   \<Lambda>.Ide_Src \<Lambda>.elementary_reduction_is_arr
             by force
           ultimately show ?thesis
             using 1 \<Lambda>.leftmost_reduction_preservation by blast
         qed
         moreover have "\<Lambda>.coinitial (\<Lambda>.leftmost_strategy (\<Lambda>.Src t) \\ t) u"
           using assms(1) calculation \<Lambda>.Arr_not_Nil \<Lambda>.Src_resid \<Lambda>.elementary_reduction_is_arr
                 \<Lambda>.is_leftmost_reduction_def \<Lambda>.seq_char \<Lambda>.sseq_imp_seq
           by force
         moreover have "\<And>v. \<lbrakk>\<Lambda>.is_leftmost_reduction v; \<Lambda>.coinitial v u\<rbrakk> \<Longrightarrow> v = u"
           by (metis \<Lambda>.arr_iff_has_source \<Lambda>.arr_resid_iff_con \<Lambda>.confluence assms(2)
               \<Lambda>.Arr_not_Nil \<Lambda>.Coinitial_iff_Con \<Lambda>.is_leftmost_reduction_def \<Lambda>.sources_char\<^sub>\<Lambda>)
         ultimately have "\<Lambda>.leftmost_strategy (\<Lambda>.Src t) \\ t = u"
           by blast
         thus ?thesis
           using assms(1) * by blast
       qed
       thus ?thesis
         using assms(1) \<Lambda>.is_leftmost_reduction_def \<Lambda>.sseq_imp_elementary_reduction1 by force
     qed
 
     lemma elementary_reduction_to_NF_is_leftmost:
     shows "\<lbrakk>\<Lambda>.elementary_reduction t; \<Lambda>.NF (Trg [t])\<rbrakk> \<Longrightarrow> \<Lambda>.leftmost_strategy (\<Lambda>.Src t) = t"
     proof (induct t)
       show "\<Lambda>.leftmost_strategy (\<Lambda>.Src \<^bold>\<sharp>) = \<^bold>\<sharp>"
         by simp
       show "\<And>x. \<lbrakk>\<Lambda>.elementary_reduction \<^bold>\<guillemotleft>x\<^bold>\<guillemotright>; \<Lambda>.NF (Trg [\<^bold>\<guillemotleft>x\<^bold>\<guillemotright>])\<rbrakk>
                    \<Longrightarrow> \<Lambda>.leftmost_strategy (\<Lambda>.Src \<^bold>\<guillemotleft>x\<^bold>\<guillemotright>) = \<^bold>\<guillemotleft>x\<^bold>\<guillemotright>"
         by auto
       show "\<And>t. \<lbrakk>\<lbrakk>\<Lambda>.elementary_reduction t; \<Lambda>.NF (Trg [t])\<rbrakk>
                     \<Longrightarrow> \<Lambda>.leftmost_strategy (\<Lambda>.Src t) = t;
                   \<Lambda>.elementary_reduction \<^bold>\<lambda>\<^bold>[t\<^bold>]; \<Lambda>.NF (Trg [\<^bold>\<lambda>\<^bold>[t\<^bold>]])\<rbrakk>
                    \<Longrightarrow> \<Lambda>.leftmost_strategy (\<Lambda>.Src \<^bold>\<lambda>\<^bold>[t\<^bold>]) = \<^bold>\<lambda>\<^bold>[t\<^bold>]"
         using lambda_calculus.NF_Lam_iff lambda_calculus.elementary_reduction_is_arr by force
       show "\<And>t1 t2. \<lbrakk>\<lbrakk>\<Lambda>.elementary_reduction t1; \<Lambda>.NF (Trg [t1])\<rbrakk>
                         \<Longrightarrow> \<Lambda>.leftmost_strategy (\<Lambda>.Src t1) = t1;
                      \<lbrakk>\<Lambda>.elementary_reduction t2; \<Lambda>.NF (Trg [t2])\<rbrakk>
                         \<Longrightarrow> \<Lambda>.leftmost_strategy (\<Lambda>.Src t2) = t2;
                       \<Lambda>.elementary_reduction (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2); \<Lambda>.NF (Trg [\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2])\<rbrakk>
                         \<Longrightarrow> \<Lambda>.leftmost_strategy (\<Lambda>.Src (\<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2)) = \<^bold>\<lambda>\<^bold>[t1\<^bold>] \<^bold>\<Zspot> t2"
         apply simp
         by (metis \<Lambda>.Ide_iff_Src_self \<Lambda>.Ide_implies_Arr)
       fix t1 t2
       assume ind1: "\<lbrakk>\<Lambda>.elementary_reduction t1; \<Lambda>.NF (Trg [t1])\<rbrakk>
                         \<Longrightarrow> \<Lambda>.leftmost_strategy (\<Lambda>.Src t1) = t1"
       assume ind2: "\<lbrakk>\<Lambda>.elementary_reduction t2; \<Lambda>.NF (Trg [t2])\<rbrakk>
                         \<Longrightarrow> \<Lambda>.leftmost_strategy (\<Lambda>.Src t2) = t2"
       assume t: "\<Lambda>.elementary_reduction (\<Lambda>.App t1 t2)"
       have t1: "\<Lambda>.Arr t1"
         using t \<Lambda>.Arr.simps(4) \<Lambda>.elementary_reduction_is_arr by blast
       have t2: "\<Lambda>.Arr t2"
         using t \<Lambda>.Arr.simps(4) \<Lambda>.elementary_reduction_is_arr by blast
       assume NF: "\<Lambda>.NF (Trg [\<Lambda>.App t1 t2])"
       have 1: "\<not> \<Lambda>.is_Lam t1"
         using NF \<Lambda>.NF_def
         apply (cases t1)
             apply simp_all
         by (metis (mono_tags) \<Lambda>.Ide.simps(1) \<Lambda>.NF_App_iff \<Lambda>.Trg.simps(2-3) \<Lambda>.lambda.discI(2))
       have 2: "\<Lambda>.NF (\<Lambda>.Trg t1) \<and> \<Lambda>.NF (\<Lambda>.Trg t2)"
         using NF t1 t2 1 \<Lambda>.NF_App_iff by simp
       show "\<Lambda>.leftmost_strategy (\<Lambda>.Src (\<Lambda>.App t1 t2)) = \<Lambda>.App t1 t2"
         using t t1 t2 1 2 ind1 ind2
         apply (cases t1)
             apply simp_all
          apply (metis \<Lambda>.Ide.simps(4) \<Lambda>.Ide_iff_Src_self \<Lambda>.Ide_iff_Trg_self
             \<Lambda>.NF_iff_has_no_redex \<Lambda>.elementary_reduction_not_ide \<Lambda>.eq_Ide_are_cong
             \<Lambda>.has_redex_iff_not_Ide_leftmost_strategy \<Lambda>.resid_Arr_Src t1)
         using \<Lambda>.Ide_iff_Src_self by blast
     qed
 
     lemma Std_path_to_NF_is_leftmost:
     shows "\<lbrakk>Std T; \<Lambda>.NF (Trg T)\<rbrakk> \<Longrightarrow> set T \<subseteq> Collect \<Lambda>.is_leftmost_reduction"
     proof -
       have 1: "\<And>t. \<lbrakk>Std (t # T); \<Lambda>.NF (Trg (t # T))\<rbrakk> \<Longrightarrow> \<Lambda>.is_leftmost_reduction t" for T
       proof (induct T)
         show "\<And>t. \<lbrakk>Std [t]; \<Lambda>.NF (Trg [t])\<rbrakk> \<Longrightarrow> \<Lambda>.is_leftmost_reduction t"
           using elementary_reduction_to_NF_is_leftmost \<Lambda>.is_leftmost_reduction_def by simp
         fix t u T
         assume ind: "\<And>t. \<lbrakk>Std (t # T); \<Lambda>.NF (Trg (t # T))\<rbrakk> \<Longrightarrow> \<Lambda>.is_leftmost_reduction t"
         assume Std: "Std (t # u # T)"
         assume "\<Lambda>.NF (Trg (t # u # T))"
         show "\<Lambda>.is_leftmost_reduction t"
           using Std \<open>\<Lambda>.NF (Trg (t # u # T))\<close> ind sseq_reflects_leftmost_reduction by auto
       qed
       show "\<lbrakk>Std T; \<Lambda>.NF (Trg T)\<rbrakk> \<Longrightarrow> set T \<subseteq> Collect \<Lambda>.is_leftmost_reduction"
       proof (induct T)
-        show "set [] \<subseteq> Collect \<Lambda>.is_leftmost_reduction"
+        show 2: "set [] \<subseteq> Collect \<Lambda>.is_leftmost_reduction"
           by simp
         fix t T
         assume ind: "\<lbrakk>Std T; \<Lambda>.NF (Trg T)\<rbrakk> \<Longrightarrow> set T \<subseteq> Collect \<Lambda>.is_leftmost_reduction"
         assume Std: "Std (t # T)" and NF: "\<Lambda>.NF (Trg (t # T))"
         show "set (t # T) \<subseteq> Collect \<Lambda>.is_leftmost_reduction"
-        proof (cases "T = []")
-          show "T = [] \<Longrightarrow> ?thesis"
-            by (metis 1 NF Std \<open>set [] \<subseteq> Collect \<Lambda>.is_leftmost_reduction\<close>
-                mem_Collect_eq set_ConsD subset_code(1))
-          assume T: "T \<noteq> []"
-          have "\<Lambda>.is_leftmost_reduction t"
-            using 1 NF Std elementary_reduction_to_NF_is_leftmost by blast
-          thus ?thesis
-            using T NF Std ind by auto
-        qed
+          by (metis 1 2 NF Std Std_consE Trg.elims ind insert_subset list.inject list.simps(15)
+                    mem_Collect_eq)
       qed
     qed
 
     theorem leftmost_reduction_theorem:
     shows "\<Lambda>.normalizing_strategy \<Lambda>.leftmost_strategy"
     proof (unfold \<Lambda>.normalizing_strategy_def, intro allI impI)
       fix a
       assume a: "\<Lambda>.normalizable a"
       show "\<exists>n. \<Lambda>.NF (\<Lambda>.reduce \<Lambda>.leftmost_strategy a n)"
       proof (cases "\<Lambda>.NF a")
         show "\<Lambda>.NF a \<Longrightarrow> ?thesis"
           by (metis lambda_calculus.reduce.simps(1))
         assume 1: "\<not> \<Lambda>.NF a"
         obtain T where T: "Arr T \<and> Src T = a \<and> \<Lambda>.NF (Trg T)"
           using a \<Lambda>.normalizable_def red_iff by auto
         have 2: "\<not> Ide T"
           using T 1 Ide_imp_Src_eq_Trg by fastforce
         obtain U where U: "Std U \<and> cong T U"
           using T 2 standardization_theorem by blast
         have 3: "set U \<subseteq> Collect \<Lambda>.is_leftmost_reduction"
           using 1 U Std_path_to_NF_is_leftmost
           by (metis Con_Arr_self Resid_parallel Src_resid T cong_implies_coinitial)
         have "\<And>U. \<lbrakk>Arr U; length U = n; set U \<subseteq> Collect \<Lambda>.is_leftmost_reduction\<rbrakk> \<Longrightarrow>
                    U = apply_strategy \<Lambda>.leftmost_strategy (Src U) (length U)" for n
         proof (induct n)
           show "\<And>U. \<lbrakk>Arr U; length U = 0; set U \<subseteq> Collect \<Lambda>.is_leftmost_reduction\<rbrakk>
                        \<Longrightarrow> U = apply_strategy \<Lambda>.leftmost_strategy (Src U) (length U)"
             by simp
           fix n U
           assume ind: "\<And>U. \<lbrakk>Arr U; length U = n; set U \<subseteq> Collect \<Lambda>.is_leftmost_reduction\<rbrakk>
                               \<Longrightarrow> U = apply_strategy \<Lambda>.leftmost_strategy (Src U) (length U)"
           assume U: "Arr U"
           assume n: "length U = Suc n"
           assume set: "set U \<subseteq> Collect \<Lambda>.is_leftmost_reduction"
           show "U = apply_strategy \<Lambda>.leftmost_strategy (Src U) (length U)"
           proof (cases "n = 0")
             show "n = 0 \<Longrightarrow> ?thesis"
               using U n 1 set \<Lambda>.is_leftmost_reduction_def
               by (cases U) auto
             assume 5: "n \<noteq> 0"
             have 4: "hd U = \<Lambda>.leftmost_strategy (Src U)"
               using n U set \<Lambda>.is_leftmost_reduction_def
               by (cases U) auto
             have 6: "tl U \<noteq> []"
               using 4 5 n U
               by (metis Suc_length_conv list.sel(3) list.size(3))
             show ?thesis
               using 4 5 6 n U set ind [of "tl U"]
               apply (cases n)
                apply simp_all
               by (metis (no_types, lifting) Arr_consE Nil_tl Nitpick.size_list_simp(2)
                   ind [of "tl U"] \<Lambda>.arr_char \<Lambda>.trg_char list.collapse list.set_sel(2)
                   old.nat.inject reduction_paths.apply_strategy.simps(2) subset_code(1))
           qed
         qed
         hence "U = apply_strategy \<Lambda>.leftmost_strategy (Src U) (length U)"
           by (metis 3 Con_implies_Arr(1) Ide.simps(1) U ide_char)
         moreover have "Src U = a"
           using T U cong_implies_coinitial
           by (metis Con_imp_eq_Srcs Con_implies_Arr(2) Ide.simps(1) Srcs_simp\<^sub>P\<^sub>W\<^sub>E empty_set
               ex_un_Src ide_char list.set_intros(1) list.simps(15))
         ultimately have "Trg U = \<Lambda>.reduce \<Lambda>.leftmost_strategy a (length U)"
           using reduce_eq_Trg_apply_strategy
           by (metis Arr.simps(1) Con_implies_Arr(1) Ide.simps(1) U a ide_char
               \<Lambda>.leftmost_strategy_is_reduction_strategy \<Lambda>.normalizable_def length_greater_0_conv)
         thus ?thesis
           by (metis Ide.simps(1) Ide_imp_Src_eq_Trg Src_resid T Trg_resid_sym U ide_char)
       qed
     qed
 
   end
 
 end
 
 
diff --git a/thys/ResiduatedTransitionSystem/ResiduatedTransitionSystem.thy b/thys/ResiduatedTransitionSystem/ResiduatedTransitionSystem.thy
--- a/thys/ResiduatedTransitionSystem/ResiduatedTransitionSystem.thy
+++ b/thys/ResiduatedTransitionSystem/ResiduatedTransitionSystem.thy
@@ -1,8849 +1,8888 @@
 chapter "Residuated Transition Systems"
 
 theory ResiduatedTransitionSystem
 imports Main
 begin
 
   section "Basic Definitions and Properties"
 
   subsection "Partial Magmas"
 
   text \<open>
     A \emph{partial magma} consists simply of a partial binary operation.
     We represent the partiality by assuming the existence of a unique value \<open>null\<close>
     that behaves as a zero for the operation.
   \<close>
 
   (* TODO: Possibly unify with Category3.partial_magma? *)
   locale partial_magma =
   fixes OP :: "'a \<Rightarrow> 'a \<Rightarrow> 'a"
   assumes ex_un_null: "\<exists>!n. \<forall>t. OP n t = n \<and> OP t n = n"
   begin
 
     definition null :: 'a
     where "null = (THE n. \<forall>t. OP n t = n \<and> OP t n = n)"
 
     lemma null_eqI:
     assumes "\<And>t. OP n t = n \<and> OP t n = n"
     shows "n = null"
       using assms null_def ex_un_null the1_equality [of "\<lambda>n. \<forall>t. OP n t = n \<and> OP t n = n"]
       by auto
     
     lemma null_is_zero [simp]:
     shows "OP null t = null" and "OP t null = null"
       using null_def ex_un_null theI' [of "\<lambda>n. \<forall>t. OP n t = n \<and> OP t n = n"]
       by auto
 
   end
 
   subsection "Residuation"
 
     text \<open>
       A \emph{residuation} is a partial binary operation subject to three axioms.
       The first, \<open>con_sym_ax\<close>, states that the domain of a residuation is symmetric.
       The second, \<open>con_imp_arr_resid\<close>, constrains the results of residuation either to be \<open>null\<close>,
       which indicates inconsistency, or something that is self-consistent, which we will
       define below to be an ``arrow''.
       The ``cube axiom'', \<open>cube_ax\<close>, states that if \<open>v\<close> can be transported by residuation
       around one side of the ``commuting square'' formed by \<open>t\<close> and \<open>u \ t\<close>, then it can also
       be transported around the other side, formed by \<open>u\<close> and \<open>t \ u\<close>, with the same result.
     \<close>
 
   type_synonym 'a resid = "'a \<Rightarrow> 'a \<Rightarrow> 'a"
 
   locale residuation = partial_magma resid
   for resid :: "'a resid" (infix "\\" 70) +
   assumes con_sym_ax: "t \\ u \<noteq> null \<Longrightarrow> u \\ t \<noteq> null"
   and con_imp_arr_resid: "t \\ u \<noteq> null \<Longrightarrow> (t \\ u) \\ (t \\ u) \<noteq> null"
   and cube_ax: "(v \\ t) \\ (u \\ t) \<noteq> null \<Longrightarrow> (v \\ t) \\ (u \\ t) = (v \\ u) \\ (t \\ u)"
   begin
 
     text \<open>
       The axiom \<open>cube_ax\<close> is equivalent to the following unconditional form.
       The locale assumptions use the weaker form to avoid having to treat
       the case \<open>(v \ t) \ (u \ t) = null\<close> specially for every interpretation.
     \<close>
 
     lemma cube:
     shows "(v \\ t) \\ (u \\ t) = (v \\ u) \\ (t \\ u)"
       using cube_ax by metis
 
     text \<open>
       We regard \<open>t\<close> and \<open>u\<close> as \emph{consistent} if the residuation \<open>t \ u\<close> is defined.
       It is convenient to make this a definition, with associated notation.
     \<close>
 
     definition con  (infix "\<frown>" 50)
     where "t \<frown> u \<equiv> t \\ u \<noteq> null"
 
     lemma conI [intro]:
     assumes "t \\ u \<noteq> null"
     shows "t \<frown> u"
       using assms con_def by blast
 
     lemma conE [elim]:
     assumes "t \<frown> u"
     and "t \\ u \<noteq> null \<Longrightarrow> T"
     shows T
       using assms con_def by simp
 
     lemma con_sym:
     assumes "t \<frown> u"
     shows "u \<frown> t"
       using assms con_def con_sym_ax by blast
 
     text \<open>
       We call \<open>t\<close> an \emph{arrow} if it is self-consistent.
     \<close>
 
     definition arr
     where "arr t \<equiv> t \<frown> t"
 
     lemma arrI [intro]:
     assumes "t \<frown> t"
     shows "arr t"
       using assms arr_def by simp
 
     lemma arrE [elim]:
     assumes "arr t"
     and "t \<frown> t \<Longrightarrow> T"
     shows T
       using assms arr_def by simp
 
     lemma not_arr_null [simp]:
     shows "\<not> arr null"
       by (auto simp add: con_def)
 
     lemma con_implies_arr:
     assumes "t \<frown> u"
     shows "arr t" and "arr u"
       using assms
       by (metis arrI con_def con_imp_arr_resid cube null_is_zero(2))+
  
     lemma arr_resid [simp]:
     assumes "t \<frown> u"
     shows "arr (t \\ u)"
       using assms con_imp_arr_resid by blast
 
     lemma arr_resid_iff_con:
     shows "arr (t \\ u) \<longleftrightarrow> t \<frown> u"
       by auto
 
     text \<open>
       The residuation of an arrow along itself is the \emph{canonical target} of the arrow.
     \<close>
 
     definition trg
     where "trg t \<equiv> t \\ t"
 
     lemma resid_arr_self:
     shows "t \\ t = trg t"
       using trg_def by auto
 
     text \<open>
       An \emph{identity} is an arrow that is its own target.
     \<close>
 
     definition ide
     where "ide a \<equiv> a \<frown> a \<and> a \\ a = a"
 
     lemma ideI [intro]:
     assumes "a \<frown> a" and "a \\ a = a"
     shows "ide a"
       using assms ide_def by auto
 
     lemma ideE [elim]:
     assumes "ide a"
     and "\<lbrakk>a \<frown> a; a \\ a = a\<rbrakk> \<Longrightarrow> T"
     shows T
       using assms ide_def by blast
 
     lemma ide_implies_arr [simp]:
     assumes "ide a"
     shows "arr a"
       using assms by blast
 
   end
 
   subsection "Residuated Transition System"
 
   text \<open>
     A \emph{residuated transition system} consists of a residuation subject to
     additional axioms that concern the relationship between identities and residuation.
     These axioms make it possible to sensibly associate with each arrow certain nonempty
     sets of identities called the \emph{sources} and \emph{targets} of the arrow.
     Axiom \<open>ide_trg\<close> states that the canonical target \<open>trg t\<close> of an arrow \<open>t\<close> is an identity.
     Axiom \<open>resid_arr_ide\<close> states that identities are right units for residuation,
     when it is defined.
     Axiom \<open>resid_ide_arr\<close> states that the residuation of an identity along an arrow is
     again an identity, assuming that the residuation is defined.
     Axiom \<open>con_imp_coinitial_ax\<close> states that if arrows \<open>t\<close> and \<open>u\<close> are consistent,
     then there is an identity that is consistent with both of them (\emph{i.e.}~they
     have a common source).
     Axiom \<open>con_target\<close> states that an identity of the form \<open>t \ u\<close>
     (which may be regarded as a ``target'' of \<open>u\<close>) is consistent with any other
     arrow \<open>v \ u\<close> obtained by residuation along \<open>u\<close>.
     We note that replacing the premise \<open>ide (t \ u)\<close> in this axiom by either \<open>arr (t \ u)\<close>
     or \<open>t \<frown> u\<close> would result in a strictly stronger statement.
   \<close>
 
   locale rts = residuation +
   assumes ide_trg [simp]: "arr t \<Longrightarrow> ide (trg t)"
   and resid_arr_ide: "\<lbrakk>ide a; t \<frown> a\<rbrakk> \<Longrightarrow> t \\ a = t"
   and resid_ide_arr [simp]: "\<lbrakk>ide a; a \<frown> t\<rbrakk> \<Longrightarrow> ide (a \\ t)"
   and con_imp_coinitial_ax: "t \<frown> u \<Longrightarrow> \<exists>a. ide a \<and> a \<frown> t \<and> a \<frown> u"
   and con_target: "\<lbrakk>ide (t \\ u); u \<frown> v\<rbrakk> \<Longrightarrow> t \\ u \<frown> v \\ u"
   begin
 
     text \<open>
       We define the \emph{sources} of an arrow \<open>t\<close> to be the identities that
       are consistent with \<open>t\<close>.
     \<close>
 
     definition sources
     where "sources t = {a. ide a \<and> t \<frown> a}"
 
     text \<open>
       We define the \emph{targets} of an arrow \<open>t\<close> to be the identities that
       are consistent with the canonical target \<open>trg t\<close>.
     \<close>
 
     definition targets
     where "targets t = {b. ide b \<and> trg t \<frown> b}"
 
     lemma in_sourcesI [intro, simp]:
     assumes "ide a" and "t \<frown> a"
     shows "a \<in> sources t"
       using assms sources_def by simp
 
     lemma in_sourcesE [elim]:
     assumes "a \<in> sources t"
     and "\<lbrakk>ide a; t \<frown> a\<rbrakk> \<Longrightarrow> T"
     shows T
       using assms sources_def by auto
 
     lemma in_targetsI [intro, simp]:
     assumes "ide b" and "trg t \<frown> b"
     shows "b \<in> targets t"
       using assms targets_def resid_arr_self by simp
 
     lemma in_targetsE [elim]:
     assumes "b \<in> targets t"
     and "\<lbrakk>ide b; trg t \<frown> b\<rbrakk> \<Longrightarrow> T"
     shows T
       using assms targets_def resid_arr_self by force
 
     lemma trg_in_targets:
     assumes "arr t"
     shows "trg t \<in> targets t"
       using assms
       by (meson ideE ide_trg in_targetsI)
 
     lemma source_is_ide:
     assumes "a \<in> sources t"
     shows "ide a"
       using assms by blast
 
     lemma target_is_ide:
     assumes "a \<in> targets t"
     shows "ide a"
       using assms by blast
 
     text \<open>
       Consistent arrows have a common source.
     \<close>
 
     lemma con_imp_common_source:
     assumes "t \<frown> u"
     shows "sources t \<inter> sources u \<noteq> {}"
       using assms
       by (meson disjoint_iff in_sourcesI con_imp_coinitial_ax con_sym)
 
     text \<open>
        Arrows are characterized by the property of having a nonempty set of sources,
        or equivalently, by that of having a nonempty set of targets.
     \<close>
 
     lemma arr_iff_has_source:
     shows "arr t \<longleftrightarrow> sources t \<noteq> {}"
       using con_imp_common_source con_implies_arr(1) sources_def by blast
 
     lemma arr_iff_has_target:
     shows "arr t \<longleftrightarrow> targets t \<noteq> {}"
       using trg_def trg_in_targets by fastforce
 
     text \<open>
       The residuation of a source of an arrow along that arrow gives a target
       of the same arrow.
       However, it is \emph{not} true that every target of an arrow \<open>t\<close> is of the
       form \<open>u \ t\<close> for some \<open>u\<close> with \<open>t \<frown> u\<close>.
     \<close>
 
     lemma resid_source_in_targets:
     assumes "a \<in> sources t"
     shows "a \\ t \<in> targets t"
       by (metis arr_resid assms con_target con_sym resid_arr_ide ide_trg
           in_sourcesE resid_ide_arr in_targetsI resid_arr_self)
 
     text \<open>
       Residuation along an identity reflects identities.
     \<close>
 
     lemma ide_backward_stable:
     assumes "ide a" and "ide (t \\ a)"
     shows "ide t"
       by (metis assms ideE resid_arr_ide arr_resid_iff_con)
 
     lemma resid_reflects_con:
     assumes "t \<frown> v" and "u \<frown> v" and "t \\ v \<frown> u \\ v"
     shows "t \<frown> u"
       using assms cube
       by (elim conE) auto
 
     lemma con_transitive_on_ide:
     assumes "ide a" and "ide b" and "ide c"
     shows "\<lbrakk>a \<frown> b; b \<frown> c\<rbrakk> \<Longrightarrow> a \<frown> c"
       using assms
       by (metis resid_arr_ide con_target con_sym)
 
     lemma sources_are_con:
     assumes "a \<in> sources t" and "a' \<in> sources t"
     shows "a \<frown> a'"
       using assms
       by (metis (no_types, lifting) CollectD con_target con_sym resid_ide_arr
           sources_def resid_reflects_con)
  
     lemma sources_con_closed:
     assumes "a \<in> sources t" and "ide a'" and "a \<frown> a'"
     shows "a' \<in> sources t"
       using assms
       by (metis (no_types, lifting) con_target con_sym resid_arr_ide
           mem_Collect_eq sources_def)
 
     lemma sources_eqI:
     assumes "sources t \<inter> sources t' \<noteq> {}"
     shows "sources t = sources t'"
       using assms sources_def sources_are_con sources_con_closed by blast
 
     lemma targets_are_con:
     assumes "b \<in> targets t" and "b' \<in> targets t"
     shows "b \<frown> b'"
       using assms sources_are_con sources_def targets_def by blast
 
     lemma targets_con_closed:
     assumes "b \<in> targets t" and "ide b'" and "b \<frown> b'"
     shows "b' \<in> targets t"
       using assms sources_con_closed sources_def targets_def by blast
 
     lemma targets_eqI:
     assumes "targets t \<inter> targets t' \<noteq> {}"
     shows "targets t = targets t'"
       using assms targets_def targets_are_con targets_con_closed by blast
 
     text \<open>
       Arrows are \emph{coinitial} if they have a common source, and \emph{coterminal}
       if they have a common target.
     \<close>
 
     definition coinitial
     where "coinitial t u \<equiv> sources t \<inter> sources u \<noteq> {}"
 
     definition coterminal
     where "coterminal t u \<equiv> targets t \<inter> targets u \<noteq> {}"
 
     lemma coinitialI [intro]:
     assumes "arr t" and "sources t = sources u"
     shows "coinitial t u"
       using assms coinitial_def arr_iff_has_source by simp
 
     lemma coinitialE [elim]:
     assumes "coinitial t u"
     and "\<lbrakk>arr t; arr u; sources t = sources u\<rbrakk> \<Longrightarrow> T"
     shows T
       using assms coinitial_def sources_eqI arr_iff_has_source by auto
 
     lemma con_imp_coinitial:
     assumes "t \<frown> u"
     shows "coinitial t u"
       using assms
       by (simp add: coinitial_def con_imp_common_source)
 
     lemma coinitial_iff:
     shows "coinitial t t' \<longleftrightarrow> arr t \<and> arr t' \<and> sources t = sources t'"
       by (metis arr_iff_has_source coinitial_def inf_idem sources_eqI)
 
     lemma coterminal_iff:
     shows "coterminal t t' \<longleftrightarrow> arr t \<and> arr t' \<and> targets t = targets t'"
       by (metis arr_iff_has_target coterminal_def inf_idem targets_eqI)
 
     lemma coterminal_iff_con_trg:
     shows "coterminal t u \<longleftrightarrow> trg t \<frown> trg u"
       by (metis coinitial_iff con_imp_coinitial coterminal_iff in_targetsE trg_in_targets
           resid_arr_self arr_resid_iff_con sources_def targets_def)
 
     lemma coterminalI [intro]:
     assumes "arr t" and "targets t = targets u"
     shows "coterminal t u"
       using assms coterminal_iff arr_iff_has_target by auto
 
     lemma coterminalE [elim]:
     assumes "coterminal t u"
     and "\<lbrakk>arr t; arr u; targets t = targets u\<rbrakk> \<Longrightarrow> T"
     shows T
       using assms coterminal_iff by auto
 
     lemma sources_resid [simp]:
     assumes "t \<frown> u"
     shows "sources (t \\ u) = targets u"
       unfolding targets_def trg_def
       using assms conI conE
       by (metis con_imp_arr_resid assms coinitial_iff con_imp_coinitial
           cube ex_un_null sources_def)
 
     lemma targets_resid_sym:
     assumes "t \<frown> u"
     shows "targets (t \\ u) = targets (u \\ t)"
       using assms
       apply (intro targets_eqI)
       by (metis (no_types, opaque_lifting) assms cube inf_idem arr_iff_has_target arr_def
           arr_resid_iff_con sources_resid)
 
     text \<open>
       Arrows \<open>t\<close> and \<open>u\<close> are \emph{sequential} if the set of targets of \<open>t\<close> equals
       the set of sources of \<open>u\<close>.
     \<close>
 
     definition seq
     where "seq t u \<equiv> arr t \<and> arr u \<and> targets t = sources u"
 
     lemma seqI [intro]:
     assumes "arr t" and "arr u" and "targets t = sources u"
     shows "seq t u"
       using assms seq_def by auto
 
     lemma seqE [elim]:
     assumes "seq t u"
     and "\<lbrakk>arr t; arr u; targets t = sources u\<rbrakk> \<Longrightarrow> T"
     shows T
       using assms seq_def by blast
 
     subsubsection "Congruence of Transitions"
 
     text \<open>
       Residuation induces a preorder \<open>\<lesssim>\<close> on transitions, defined by \<open>t \<lesssim> u\<close> if and only if
       \<open>t \ u\<close> is an identity.
     \<close>
 
     abbreviation prfx  (infix "\<lesssim>" 50)
     where "t \<lesssim> u \<equiv> ide (t \\ u)"
 
     lemma prfx_implies_con:
     assumes "t \<lesssim> u"
     shows "t \<frown> u"
       using assms arr_resid_iff_con by blast
 
     lemma prfx_reflexive:
     assumes "arr t"
     shows "t \<lesssim> t"
       by (simp add: assms resid_arr_self)
 
     lemma prfx_transitive [trans]:
     assumes "t \<lesssim> u" and "u \<lesssim> v"
     shows "t \<lesssim> v"
       using assms con_target resid_ide_arr ide_backward_stable cube conI
       by metis
 
     text \<open>
       The equivalence \<open>\<sim>\<close> associated with \<open>\<lesssim>\<close> is substitutive with respect to residuation.
     \<close>
 
     abbreviation cong  (infix "\<sim>" 50)
     where "t \<sim> u \<equiv> t \<lesssim> u \<and> u \<lesssim> t"
 
     lemma cong_reflexive:
     assumes "arr t"
     shows "t \<sim> t"
       using assms prfx_reflexive by simp
 
     lemma cong_symmetric:
     assumes "t \<sim> u"
     shows "u \<sim> t"
       using assms by simp
 
     lemma cong_transitive [trans]:
     assumes "t \<sim> u" and "u \<sim> v"
     shows "t \<sim> v"
       using assms prfx_transitive by auto
 
     lemma cong_subst_left:
     assumes "t \<sim> t'" and "t \<frown> u"
     shows "t' \<frown> u" and "t \\ u \<sim> t' \\ u"
       apply (meson assms con_sym con_target prfx_implies_con resid_reflects_con)
       by (metis assms con_sym con_target cube prfx_implies_con resid_ide_arr resid_reflects_con)
 
     lemma cong_subst_right:
     assumes "u \<sim> u'" and "t \<frown> u"
     shows "t \<frown> u'" and "t \\ u \<sim> t \\ u'"
     proof -
       have 1: "t \<frown> u' \<and> t \\ u' \<frown> u \\ u' \<and>
                 (t \\ u) \\ (u' \\ u) = (t \\ u') \\ (u \\ u')"
         using assms cube con_sym con_target cong_subst_left(1) by meson
       show "t \<frown> u'"
         using 1 by simp
       show "t \\ u \<sim> t \\ u'"
         by (metis 1 arr_resid_iff_con assms(1) cong_reflexive resid_arr_ide)
     qed
 
     lemma cong_implies_coinitial:
     assumes "u \<sim> u'"
     shows "coinitial u u'"
       using assms con_imp_coinitial prfx_implies_con by simp
 
     lemma cong_implies_coterminal:
     assumes "u \<sim> u'"
     shows "coterminal u u'"
       using assms
       by (metis con_implies_arr(1) coterminalI ideE prfx_implies_con sources_resid
           targets_resid_sym)
 
     lemma ide_imp_con_iff_cong:
     assumes "ide t" and "ide u"
     shows "t \<frown> u \<longleftrightarrow> t \<sim> u"
       using assms
       by (metis con_sym resid_ide_arr prfx_implies_con)
 
     lemma sources_are_cong:
     assumes "a \<in> sources t" and "a' \<in> sources t"
     shows "a \<sim> a'"
       using assms sources_are_con
       by (metis CollectD ide_imp_con_iff_cong sources_def)
 
     lemma sources_cong_closed:
     assumes "a \<in> sources t" and "a \<sim> a'"
     shows "a' \<in> sources t"
       using assms sources_def
       by (meson in_sourcesE in_sourcesI cong_subst_right(1) ide_backward_stable)
 
     lemma targets_are_cong:
     assumes "b \<in> targets t" and "b' \<in> targets t"
     shows "b \<sim> b'"
       using assms(1-2) sources_are_cong sources_def targets_def by blast
 
     lemma targets_cong_closed:
     assumes "b \<in> targets t" and "b \<sim> b'"
     shows "b' \<in> targets t"
       using assms targets_def sources_cong_closed sources_def by blast
 
     lemma targets_char:
     shows "targets t = {b. arr t \<and> t \\ t \<sim> b}"
       unfolding targets_def
       by (metis (no_types, lifting) con_def con_implies_arr(2) con_sym cong_reflexive
           ide_def resid_arr_ide trg_def)
 
     lemma coinitial_ide_are_cong:
     assumes "ide a" and "ide a'" and "coinitial a a'"
     shows "a \<sim> a'"
       using assms coinitial_def
       by (metis ideE in_sourcesI coinitialE sources_are_cong)
 
     lemma cong_respects_seq:
     assumes "seq t u" and "cong t t'" and "cong u u'"
     shows "seq t' u'"
       by (metis assms coterminalE rts.coinitialE rts.cong_implies_coinitial
           rts.cong_implies_coterminal rts_axioms seqE seqI)
 
   end
 
   subsection "Weakly Extensional RTS"
 
   text \<open>
     A \emph{weakly extensional} RTS is an RTS that satisfies the additional condition that
     identity arrows have trivial congruence classes.  This axiom has a number of useful
     consequences, including that each arrow has a unique source and target.
   \<close>
 
   locale weakly_extensional_rts = rts +
   assumes weak_extensionality: "\<lbrakk>t \<sim> u; ide t; ide u\<rbrakk> \<Longrightarrow> t = u"
   begin
 
     lemma con_ide_are_eq:
     assumes "ide a" and "ide a'" and "a \<frown> a'"
     shows "a = a'"
       using assms ide_imp_con_iff_cong weak_extensionality by blast
 
     lemma coinitial_ide_are_eq:
     assumes "ide a" and "ide a'" and "coinitial a a'"
     shows "a = a'"
       using assms coinitial_def con_ide_are_eq by blast
 
     lemma arr_has_un_source:
     assumes "arr t"
     shows "\<exists>!a. a \<in> sources t"
       using assms
       by (meson arr_iff_has_source con_ide_are_eq ex_in_conv in_sourcesE sources_are_con)
 
     lemma arr_has_un_target:
     assumes "arr t"
     shows "\<exists>!b. b \<in> targets t"
       using assms
       by (metis arrE arr_has_un_source arr_resid sources_resid)
 
     definition src
     where "src t \<equiv> if arr t then THE a. a \<in> sources t else null"
 
     lemma src_in_sources:
     assumes "arr t"
     shows "src t \<in> sources t"
       using assms src_def arr_has_un_source
             the1I2 [of "\<lambda>a. a \<in> sources t" "\<lambda>a. a \<in> sources t"]
       by simp
 
     lemma src_eqI:
     assumes "ide a" and "a \<frown> t"
     shows "src t = a"
       using assms src_in_sources
       by (metis arr_has_un_source resid_arr_ide in_sourcesI arr_resid_iff_con con_sym)
 
     lemma sources_char:
     shows "sources t = {a. arr t \<and> src t = a}"
       using src_in_sources arr_has_un_source arr_iff_has_source by auto
 
     lemma targets_char\<^sub>W\<^sub>E:
     shows "targets t = {b. arr t \<and> trg t = b}"
       using trg_in_targets arr_has_un_target arr_iff_has_target by auto
 
     lemma arr_src_iff_arr [iff]:
     shows "arr (src t) \<longleftrightarrow> arr t"
       by (metis arrI conE null_is_zero(2) sources_are_con arrE src_def src_in_sources)
 
     lemma arr_trg_iff_arr [iff]:
     shows "arr (trg t) \<longleftrightarrow> arr t"
       by (metis arrI arrE arr_resid_iff_con resid_arr_self)
 
     lemma con_imp_eq_src:
     assumes "t \<frown> u"
     shows "src t = src u"
       using assms
       by (metis con_imp_coinitial_ax src_eqI)
 
     lemma src_resid [simp]:
     assumes "t \<frown> u"
     shows "src (t \\ u) = trg u"
       using assms
       by (metis arr_resid_iff_con con_implies_arr(2) arr_has_un_source trg_in_targets
                 sources_resid src_in_sources)
 
     lemma trg_resid_sym:
     assumes "t \<frown> u"
     shows "trg (t \\ u) = trg (u \\ t)"
       using assms
       by (metis arr_has_un_target arr_resid con_sym targets_resid_sym trg_in_targets)
 
     lemma apex_sym:
     shows "trg (t \\ u) = trg (u \\ t)"
       using trg_resid_sym con_def by metis
 
     lemma seqI\<^sub>W\<^sub>E [intro, simp]:
     assumes "arr u" and "arr t" and "trg t = src u"
     shows "seq t u"
       using assms
       by (metis (mono_tags, lifting) arrE in_sourcesE resid_arr_ide sources_resid
           resid_arr_self seqI sources_are_con src_in_sources)
 
     lemma seqE\<^sub>W\<^sub>E [elim]:
     assumes "seq t u"
     and "\<lbrakk>arr u; arr t; trg t = src u\<rbrakk> \<Longrightarrow> T"
     shows T
       using assms
       by (metis arr_has_un_source seq_def src_in_sources trg_in_targets)
 
     lemma coinitial_iff\<^sub>W\<^sub>E:
     shows "coinitial t u \<longleftrightarrow> arr t \<and> arr u \<and> src t = src u"
       by (metis arr_has_un_source coinitial_def coinitial_iff disjoint_iff_not_equal
           src_in_sources)
 
     lemma coterminal_iff\<^sub>W\<^sub>E:
     shows "coterminal t u \<longleftrightarrow> arr t \<and> arr u \<and> trg t = trg u"
       by (metis arr_has_un_target coterminal_iff_con_trg coterminal_iff trg_in_targets)
 
     lemma coinitialI\<^sub>W\<^sub>E [intro]:
     assumes "arr t" and "src t = src u"
     shows "coinitial t u"
       using assms coinitial_iff\<^sub>W\<^sub>E by (metis arr_src_iff_arr)
 
     lemma coinitialE\<^sub>W\<^sub>E [elim]:
     assumes "coinitial t u"
     and "\<lbrakk>arr t; arr u; src t = src u\<rbrakk> \<Longrightarrow> T"
     shows T
       using assms coinitial_iff\<^sub>W\<^sub>E by blast
 
     lemma coterminalI\<^sub>W\<^sub>E [intro]:
     assumes "arr t" and "trg t = trg u"
     shows "coterminal t u"
       using assms coterminal_iff\<^sub>W\<^sub>E by (metis arr_trg_iff_arr)
 
     lemma coterminalE\<^sub>W\<^sub>E [elim]:
     assumes "coterminal t u"
     and "\<lbrakk>arr t; arr u; trg t = trg u\<rbrakk> \<Longrightarrow> T"
     shows T
       using assms coterminal_iff\<^sub>W\<^sub>E by blast
 
     lemma ide_src [simp]:
     assumes "arr t"
     shows "ide (src t)"
       using assms
       by (metis arrE con_imp_coinitial_ax src_eqI)
 
     lemma src_ide [simp]:
     assumes "ide a"
     shows "src a = a"
       using arrI assms src_eqI by blast
 
     lemma trg_ide [simp]:
     assumes "ide a"
     shows "trg a = a"
       using assms resid_arr_self by force
 
     lemma ide_iff_src_self:
     assumes "arr a"
     shows "ide a \<longleftrightarrow> src a = a"
       using assms by (metis ide_src src_ide)
 
     lemma ide_iff_trg_self:
     assumes "arr a"
     shows "ide a \<longleftrightarrow> trg a = a"
       using assms ide_def resid_arr_self by auto
 
     lemma src_src [simp]:
     shows "src (src t) = src t"
       using ide_src src_def src_ide by auto
 
     lemma trg_trg [simp]:
     shows "trg (trg t) = trg t"
       by (metis con_def cong_reflexive ide_def null_is_zero(2) resid_arr_self
           residuation.con_implies_arr(1) residuation_axioms)
 
     lemma src_trg [simp]:
     shows "src (trg t) = trg t"
       by (metis con_def not_arr_null src_def src_resid trg_def)
 
     lemma trg_src [simp]:
     shows "trg (src t) = src t"
       by (metis ide_src null_is_zero(2) resid_arr_self src_def trg_ide)
 
     lemma resid_ide:
     assumes "ide a" and "coinitial a t"
     shows (* [simp]: *) "t \\ a = t" and "a \\ t = trg t"
       using assms resid_arr_ide apply blast
       using assms
       by (metis con_def con_sym_ax ideE in_sourcesE in_sourcesI resid_ide_arr
           coinitialE src_ide src_resid)
 
   end
 
   subsection "Extensional RTS"
 
   text \<open>
     An \emph{extensional} RTS is an RTS in which all arrows have trivial congruence classes;
     that is, congruent arrows are equal.
   \<close>
 
   locale extensional_rts = rts +
   assumes extensional: "t \<sim> u \<Longrightarrow> t = u"
   begin
 
     sublocale weakly_extensional_rts
       using extensional
       by unfold_locales auto
 
     lemma cong_char:
     shows "t \<sim> u \<longleftrightarrow> arr t \<and> t = u"
       by (metis arrI cong_reflexive prfx_implies_con extensional)
 
   end
 
   subsection "Composites of Transitions"
 
   text \<open>
     Residuation can be used to define a notion of composite of transitions.
     Composites are not unique, but they are unique up to congruence.
   \<close>
 
   context rts
   begin
 
     definition composite_of
     where "composite_of u t v \<equiv> u \<lesssim> v \<and> v \\ u \<sim> t"
 
     lemma composite_ofI [intro]:
     assumes "u \<lesssim> v" and "v \\ u \<sim> t"
     shows "composite_of u t v"
       using assms composite_of_def by blast
 
     lemma composite_ofE [elim]:
     assumes "composite_of u t v"
     and "\<lbrakk>u \<lesssim> v; v \\ u \<sim> t\<rbrakk> \<Longrightarrow> T"
     shows T
       using assms composite_of_def by auto
 
     lemma arr_composite_of:
     assumes "composite_of u t v"
     shows "arr v"
       using assms
       by (meson composite_of_def con_implies_arr(2) prfx_implies_con)
 
     lemma composite_of_unq_upto_cong:
     assumes "composite_of u t v" and "composite_of u t v'"
     shows "v \<sim> v'"
       using assms cube ide_backward_stable prfx_transitive
       by (elim composite_ofE) metis
 
     lemma composite_of_ide_arr:
     assumes "ide a"
     shows "composite_of a t t \<longleftrightarrow> t \<frown> a"
       using assms
       by (metis composite_of_def con_implies_arr(1) con_sym resid_arr_ide resid_ide_arr
           prfx_implies_con prfx_reflexive)
 
     lemma composite_of_arr_ide:
     assumes "ide b"
     shows "composite_of t b t \<longleftrightarrow> t \\ t \<frown> b"
       using assms
       by (metis arr_resid_iff_con composite_of_def ide_imp_con_iff_cong con_implies_arr(1)
           prfx_implies_con prfx_reflexive)
 
     lemma composite_of_source_arr:
     assumes "arr t" and "a \<in> sources t"
     shows "composite_of a t t"
       using assms composite_of_ide_arr sources_def by auto
 
     lemma composite_of_arr_target:
     assumes "arr t" and "b \<in> targets t"
     shows "composite_of t b t"
       by (metis arrE assms composite_of_arr_ide in_sourcesE sources_resid)
 
     lemma composite_of_ide_self:
     assumes "ide a"
     shows "composite_of a a a"
       using assms composite_of_ide_arr by blast
 
     lemma con_prfx_composite_of:
     assumes "composite_of t u w"
     shows "t \<frown> w" and "w \<frown> v \<Longrightarrow> t \<frown> v"
       using assms apply force
       using assms composite_of_def con_target prfx_implies_con
             resid_reflects_con con_sym
         by meson
 
     lemma sources_composite_of:
     assumes "composite_of u t v"
     shows "sources v = sources u"
       using assms
       by (meson arr_resid_iff_con composite_of_def con_imp_coinitial cong_implies_coinitial
           coinitial_iff)
 
     lemma targets_composite_of:
     assumes "composite_of u t v"
     shows "targets v = targets t"
     proof -
       have "targets t = targets (v \\ u)"
         using assms composite_of_def
         by (meson cong_implies_coterminal coterminal_iff)
       also have "... = targets (u \\ v)"
         using assms targets_resid_sym con_prfx_composite_of by metis
       also have "... = targets v"
         using assms composite_of_def
         by (metis prfx_implies_con sources_resid ideE)
       finally show ?thesis by auto
     qed
 
     lemma resid_composite_of:
     assumes "composite_of t u w" and "w \<frown> v"
     shows "v \\ t \<frown> w \\ t"
     and "v \\ t \<frown> u"
     and "v \\ w \<sim> (v \\ t) \\ u"
     and "composite_of (t \\ v) (u \\ (v \\ t)) (w \\ v)"
     proof -
       show 0: "v \\ t \<frown> w \\ t"
         using assms con_def
         by (metis con_target composite_ofE conE con_sym cube)
       show 1: "v \\ w \<sim> (v \\ t) \\ u"
       proof -
         have "v \\ w = (v \\ w) \\ (t \\ w)"
           using assms composite_of_def
           by (metis (no_types, opaque_lifting) con_target con_sym resid_arr_ide)
         also have "... = (v \\ t) \\ (w \\ t)"
           using assms cube by metis
         also have "... \<sim> (v \\ t) \\ u"
           using assms 0 cong_subst_right(2) [of "w \\ t" u "v \\ t"] by blast
         finally show ?thesis by blast
       qed
       show 2: "v \\ t \<frown> u"
         using assms 1 by force
       show "composite_of (t \\ v) (u \\ (v \\ t)) (w \\ v)"
       proof (unfold composite_of_def, intro conjI)
         show "t \\ v \<lesssim> w \\ v"
           using assms cube con_target composite_of_def resid_ide_arr by metis
         show "(w \\ v) \\ (t \\ v) \<lesssim> u \\ (v \\ t)"
           by (metis assms(1) 2 composite_ofE con_sym cong_subst_left(2) cube)
         thus "u \\ (v \\ t) \<lesssim> (w \\ v) \\ (t \\ v)"
           using assms
           by (metis composite_of_def con_implies_arr(2) cong_subst_left(2)
               prfx_implies_con arr_resid_iff_con cube)
       qed
     qed
 
     lemma con_composite_of_iff:
     assumes "composite_of t u v"
     shows "w \<frown> v \<longleftrightarrow> w \\ t \<frown> u"
       by (meson arr_resid_iff_con assms composite_ofE con_def con_implies_arr(1)
           con_sym_ax cong_subst_right(1) resid_composite_of(2) resid_reflects_con)
 
     definition composable
     where "composable t u \<equiv> \<exists>v. composite_of t u v"
 
     lemma composableD [dest]:
     assumes "composable t u"
     shows "arr t" and "arr u" and "targets t = sources u"
       using assms arr_composite_of arr_iff_has_source composable_def sources_composite_of
             arr_composite_of arr_iff_has_target composable_def targets_composite_of
         apply auto[2]
       by (metis assms composable_def composite_ofE con_prfx_composite_of(1) con_sym
           cong_implies_coinitial coinitial_iff sources_resid)
 
     lemma composable_imp_seq:
     assumes "composable t u"
     shows "seq t u"
       using assms by blast
 
     lemma bounded_imp_con:
     assumes "composite_of t u v" and "composite_of t' u' v"
     shows "con t t'"
       by (meson assms composite_of_def con_prfx_composite_of prfx_implies_con
           arr_resid_iff_con con_implies_arr(2))
 
     lemma composite_of_cancel_left:
     assumes "composite_of t u v" and "composite_of t u' v"
     shows "u \<sim> u'"
       using assms composite_of_def cong_transitive by blast
 
   end
 
   subsubsection "RTS with Composites"
 
   locale rts_with_composites = rts +
   assumes has_composites: "seq t u \<Longrightarrow> composable t u"
   begin
 
     lemma composable_iff_seq:
     shows "composable g f \<longleftrightarrow> seq g f"
       using composable_imp_seq has_composites by blast
 
     lemma obtains_composite_of:
     assumes "seq g f"
     obtains h where "composite_of g f h"
       using assms has_composites composable_def by blast
 
     lemma diamond_commutes_upto_cong:
     assumes "composite_of t (u \\ t) v" and "composite_of u (t \\ u) v'"
     shows "v \<sim> v'"
       using assms cube ide_backward_stable prfx_transitive
       by (elim composite_ofE) metis
 
   end
 
   subsection "Joins of Transitions"
 
   context rts
   begin
 
     text \<open>
       Transition \<open>v\<close> is a \emph{join} of \<open>u\<close> and \<open>v\<close> when \<open>v\<close> is the diagonal of the square
       formed by \<open>u\<close>, \<open>v\<close>, and their residuals.  As was the case for composites,
       joins in an RTS are not unique, but they are unique up to congruence.
     \<close>
 
     definition join_of
     where "join_of t u v \<equiv> composite_of t (u \\ t) v \<and> composite_of u (t \\ u) v"
 
     lemma join_ofI [intro]:
     assumes "composite_of t (u \\ t) v" and "composite_of u (t \\ u) v"
     shows "join_of t u v"
       using assms join_of_def by simp
 
     lemma join_ofE [elim]:
     assumes "join_of t u v"
     and "\<lbrakk>composite_of t (u \\ t) v; composite_of u (t \\ u) v\<rbrakk> \<Longrightarrow> T"
     shows T
       using assms join_of_def by simp
 
     definition joinable
     where "joinable t u \<equiv> \<exists>v. join_of t u v"
 
     lemma joinable_implies_con:
     assumes "joinable t u"
     shows "t \<frown> u"
       by (meson assms bounded_imp_con join_of_def joinable_def)
 
     lemma joinable_implies_coinitial:
     assumes "joinable t u"
     shows "coinitial t u"
       using assms
       by (simp add: con_imp_coinitial joinable_implies_con)
 
     lemma join_of_un_upto_cong:
     assumes "join_of t u v" and "join_of t u v'"
     shows "v \<sim> v'"
       using assms join_of_def composite_of_unq_upto_cong by auto
 
     lemma join_of_symmetric:
     assumes "join_of t u v"
     shows "join_of u t v"
       using assms join_of_def by simp
 
     lemma join_of_arr_self:
     assumes "arr t"
     shows "join_of t t t"
       by (meson assms composite_of_arr_ide ideE join_of_def prfx_reflexive)
 
     lemma join_of_arr_src:
     assumes "arr t" and "a \<in> sources t"
     shows "join_of a t t" and "join_of t a t"
     proof -
       show "join_of a t t"
         by (meson assms composite_of_arr_target composite_of_def composite_of_source_arr join_of_def
                   prfx_transitive resid_source_in_targets)
       thus "join_of t a t"
         using join_of_symmetric by blast
     qed
 
     lemma sources_join_of:
     assumes "join_of t u v"
     shows "sources t = sources v" and "sources u = sources v"
       using assms join_of_def sources_composite_of by blast+
 
     lemma targets_join_of:
     assumes "join_of t u v"
     shows "targets (t \\ u) = targets v" and "targets (u \\ t) = targets v"
       using assms join_of_def targets_composite_of by blast+
 
     lemma join_of_resid:
     assumes "join_of t u w" and "con v w"
     shows "join_of (t \\ v) (u \\ v) (w \\ v)"
       using assms con_sym cube join_of_def resid_composite_of(4) by fastforce
     
     lemma con_with_join_of_iff:
     assumes "join_of t u w"
     shows "u \<frown> v \<and> v \\ u \<frown> t \\ u \<Longrightarrow> w \<frown> v"
     and "w \<frown> v \<Longrightarrow> t \<frown> v \<and> v \\ t \<frown> u \\ t"
     proof -
       have *: "t \<frown> v \<and> v \\ t \<frown> u \\ t \<longleftrightarrow> u \<frown> v \<and> v \\ u \<frown> t \\ u"
         by (metis arr_resid_iff_con con_implies_arr(1) con_sym cube)
       show "u \<frown> v \<and> v \\ u \<frown> t \\ u \<Longrightarrow> w \<frown> v"
         by (meson assms con_composite_of_iff con_sym join_of_def)
       show "w \<frown> v \<Longrightarrow> t \<frown> v \<and> v \\ t \<frown> u \\ t"
         by (meson assms con_prfx_composite_of join_of_def resid_composite_of(2))
     qed
 
   end
 
   subsubsection "RTS with Joins"
 
   locale rts_with_joins = rts +
   assumes has_joins: "t \<frown> u \<Longrightarrow> joinable t u"
 
   subsection "Joins and Composites in a Weakly Extensional RTS"
 
   context weakly_extensional_rts
   begin
 
     lemma src_composite_of:
     assumes "composite_of u t v"
     shows "src v = src u"
       using assms
       by (metis con_imp_eq_src con_prfx_composite_of(1))
 
     lemma trg_composite_of:
     assumes "composite_of u t v"
     shows "trg v = trg t"
       by (metis arr_composite_of arr_has_un_target arr_iff_has_target assms
           targets_composite_of trg_in_targets)
 
     lemma src_join_of:
     assumes "join_of t u v"
     shows "src t = src v" and "src u = src v"
       by (metis assms join_ofE src_composite_of)+
 
     lemma trg_join_of:
     assumes "join_of t u v"
     shows "trg (t \\ u) = trg v" and "trg (u \\ t) = trg v"
       by (metis assms join_of_def trg_composite_of)+
 
   end
 
   subsection "Joins and Composites in an Extensional RTS"
 
   context extensional_rts
   begin
 
     lemma composite_of_unique:
     assumes "composite_of t u v" and "composite_of t u v'"
     shows "v = v'"
       using assms composite_of_unq_upto_cong extensional by fastforce
 
     text \<open>
       Here we define composition of transitions.  Note that we compose transitions
       in diagram order, rather than in the order used for function composition.
       This may eventually lead to confusion, but here (unlike in the case of a category)
       transitions are typically not functions, so we don't have the constraint of having
       to conform to the order of function application and composition, and diagram order
       seems more natural.
     \<close>
 
     definition comp  (infixl "\<cdot>" 55)
     where "t \<cdot> u \<equiv> if composable t u then THE v. composite_of t u v else null"
 
     lemma comp_is_composite_of:
     assumes "composite_of t u v"
     shows "composite_of t u (t \<cdot> u)" and "t \<cdot> u = v"
     proof -
       show "composite_of t u (t \<cdot> u)"
         using assms comp_def composite_of_unique the1I2 [of "composite_of t u" "composite_of t u"]
               composable_def
         by metis
       thus "t \<cdot> u = v"
         using assms composite_of_unique by simp
     qed
 
     lemma comp_null [simp]:
     shows "null \<cdot> t = null" and "t \<cdot> null = null"
       by (meson composableD not_arr_null comp_def)+
 
     lemma composable_iff_arr_comp:
     shows "composable t u \<longleftrightarrow> arr (t \<cdot> u)"
       by (metis arr_composite_of comp_is_composite_of(2) composable_def comp_def not_arr_null)
 
     lemma composable_iff_comp_not_null:
     shows "composable t u \<longleftrightarrow> t \<cdot> u \<noteq> null"
       by (metis composable_iff_arr_comp comp_def not_arr_null)
 
     lemma comp_src_arr [simp]:
     assumes "arr t" and "src t = a"
     shows "a \<cdot> t = t"
       using assms comp_is_composite_of(2) composite_of_source_arr src_in_sources by blast
 
     lemma comp_arr_trg [simp]:
     assumes "arr t" and "trg t = b"
     shows "t \<cdot> b = t"
       using assms comp_is_composite_of(2) composite_of_arr_target trg_in_targets by blast
 
     lemma comp_ide_self:
     assumes "ide a"
     shows "a \<cdot> a = a"
       using assms comp_is_composite_of(2) composite_of_ide_self by fastforce
 
     lemma arr_comp [intro, simp]:
     assumes "composable t u"
     shows "arr (t \<cdot> u)"
       using assms composable_iff_arr_comp by blast
 
     lemma trg_comp [simp]:
     assumes "composable t u"
     shows "trg (t \<cdot> u) = trg u"
       by (metis arr_has_un_target assms comp_is_composite_of(2) composable_def
           composable_imp_seq arr_iff_has_target seq_def targets_composite_of trg_in_targets)
 
     lemma src_comp [simp]:
     assumes "composable t u"
     shows "src (t \<cdot> u) = src t"
       using assms comp_is_composite_of arr_iff_has_source sources_composite_of src_def
             composable_def
       by auto
 
     lemma con_comp_iff:
     shows "w \<frown> t \<cdot> u \<longleftrightarrow> composable t u \<and> w \\ t \<frown> u"
       by (meson comp_is_composite_of(1) con_composite_of_iff con_sym con_implies_arr(2)
                 composable_def composable_iff_arr_comp)
 
     lemma con_compI [intro]:
     assumes "composable t u" and "w \\ t \<frown> u"
     shows "w \<frown> t \<cdot> u" and "t \<cdot> u \<frown> w"
       using assms con_comp_iff con_sym by blast+
 
     lemma resid_comp:
     assumes "t \<cdot> u \<frown> w"
     shows "w \\ (t \<cdot> u) = (w \\ t) \\ u"
     and "(t \<cdot> u) \\ w = (t \\ w) \<cdot> (u \\ (w \\ t))"
     proof -
       have 1: "composable t u"
         using assms composable_iff_comp_not_null by force
       show "w \\ (t \<cdot> u) = (w \\ t) \\ u"
         using 1
         by (meson assms cong_char composable_def resid_composite_of(3) comp_is_composite_of(1))
       show "(t \<cdot> u) \\ w = (t \\ w) \<cdot> (u \\ (w \\ t))"
         using assms 1 composable_def comp_is_composite_of(2) resid_composite_of
         by metis
     qed
 
     lemma prfx_decomp:
     assumes "t \<lesssim> u"
     shows "t \<cdot> (u \\ t) = u"
       by (meson assms arr_resid_iff_con comp_is_composite_of(2) composite_of_def con_sym
           cong_reflexive prfx_implies_con)
 
     lemma prfx_comp:
     assumes "arr u" and "t \<cdot> v = u"
     shows "t \<lesssim> u"
       by (metis assms comp_is_composite_of(2) composable_def composable_iff_arr_comp
                 composite_of_def)
 
     lemma comp_eqI:
     assumes "t \<lesssim> v" and "u = v \\ t"
     shows "t \<cdot> u = v"
       by (metis assms prfx_decomp)
 
     lemma comp_assoc:
     assumes "composable (t \<cdot> u) v"
     shows "t \<cdot> (u \<cdot> v) = (t \<cdot> u) \<cdot> v"
     proof -
       have 1: "t \<lesssim> (t \<cdot> u) \<cdot> v"
         by (meson assms composable_iff_arr_comp composableD prfx_comp
             prfx_transitive)
       moreover have "((t \<cdot> u) \<cdot> v) \\ t = u \<cdot> v"
       proof -
         have "((t \<cdot> u) \<cdot> v) \\ t = ((t \<cdot> u) \\ t) \<cdot> (v \\ (t \\ (t \<cdot> u)))" 
           by (meson assms calculation con_sym prfx_implies_con resid_comp(2))
         also have "... = u \<cdot> v"
         proof -
           have 2: "(t \<cdot> u) \\ t = u"
             by (metis assms comp_is_composite_of(2) composable_def composable_iff_arr_comp
                       composable_imp_seq composite_of_def extensional seqE)
           moreover have "v \\ (t \\ (t \<cdot> u)) = v"
             using assms
             by (meson 1 con_comp_iff con_sym composable_imp_seq resid_arr_ide
                 prfx_implies_con prfx_comp seqE)
           ultimately show ?thesis by simp
         qed
         finally show ?thesis by blast
       qed
       ultimately show "t \<cdot> (u \<cdot> v) = (t \<cdot> u) \<cdot> v"
         by (metis comp_eqI)
     qed
 
     text \<open>
       We note the following assymmetry: \<open>composable (t \<cdot> u) v \<Longrightarrow> composable u v\<close> is true,
       but \<open>composable t (u \<cdot> v) \<Longrightarrow> composable t u\<close> is not.
     \<close>
 
     lemma comp_cancel_left:
     assumes "arr (t \<cdot> u)" and "t \<cdot> u = t \<cdot> v"
     shows "u = v"
       using assms
       by (metis composable_def composable_iff_arr_comp composite_of_cancel_left extensional
           comp_is_composite_of(2))
 
     lemma comp_resid_prfx [simp]:
     assumes "arr (t \<cdot> u)"
     shows "(t \<cdot> u) \\ t = u"
       using assms
       by (metis comp_cancel_left comp_eqI prfx_comp)
 
     lemma bounded_imp_con\<^sub>E:
     assumes "t \<cdot> u \<sim> t' \<cdot> u'"
     shows "t \<frown> t'"
       by (metis arr_resid_iff_con assms con_comp_iff con_implies_arr(2) prfx_implies_con
                 con_sym)
 
     lemma join_of_unique:
     assumes "join_of t u v" and "join_of t u v'"
     shows "v = v'"
       using assms join_of_def composite_of_unique by blast
 
     definition join  (infix "\<squnion>" 52)
     where "t \<squnion> u \<equiv> if joinable t u then THE v. join_of t u v else null"
 
     lemma join_is_join_of:
     assumes "joinable t u"
     shows "join_of t u (t \<squnion> u)"
       using assms joinable_def join_def join_of_unique the1I2 [of "join_of t u" "join_of t u"]
       by force
 
     lemma joinable_iff_arr_join:
     shows "joinable t u \<longleftrightarrow> arr (t \<squnion> u)"
       by (metis cong_char join_is_join_of join_of_un_upto_cong not_arr_null join_def)
 
     lemma joinable_iff_join_not_null:
     shows "joinable t u \<longleftrightarrow> t \<squnion> u \<noteq> null"
       by (metis join_def joinable_iff_arr_join not_arr_null)
 
     lemma join_sym:
     assumes "t \<squnion> u \<noteq> null"
     shows "t \<squnion> u = u \<squnion> t"
       using assms
       by (meson join_def join_is_join_of join_of_symmetric join_of_unique joinable_def)
 
     lemma src_join:
     assumes "joinable t u"
     shows "src (t \<squnion> u) = src t"
       using assms
       by (metis con_imp_eq_src con_prfx_composite_of(1) join_is_join_of join_of_def)
 
     lemma trg_join:
     assumes "joinable t u"
     shows "trg (t \<squnion> u) = trg (t \\ u)"
       using assms
       by (metis arr_resid_iff_con join_is_join_of joinable_iff_arr_join joinable_implies_con
           in_targetsE src_eqI targets_join_of(1) trg_in_targets)
 
     lemma resid_join\<^sub>E [simp]:
     assumes "joinable t u" and "v \<frown> t \<squnion> u"
     shows "v \\ (t \<squnion> u) = (v \\ u) \\ (t \\ u)"
     and "v \\ (t \<squnion> u) = (v \\ t) \\ (u \\ t)"
     and "(t \<squnion> u) \\ v = (t \\ v) \<squnion> (u \\ v)"
     proof -
       show 1: "v \\ (t \<squnion> u) = (v \\ u) \\ (t \\ u)"
         by (meson assms con_sym join_of_def resid_composite_of(3) extensional join_is_join_of)
       show "v \\ (t \<squnion> u) = (v \\ t) \\ (u \\ t)"
         by (metis "1" cube)
       show "(t \<squnion> u) \\ v = (t \\ v) \<squnion> (u \\ v)"
         using assms joinable_def join_of_resid join_is_join_of extensional
         by (meson join_of_unique)
     qed
 
     lemma join_eqI:
     assumes "t \<lesssim> v" and "u \<lesssim> v" and "v \\ u = t \\ u" and "v \\ t = u \\ t"
     shows "t \<squnion> u = v"
       using assms composite_of_def cube ideE join_of_def joinable_def join_of_unique
             join_is_join_of trg_def
       by metis
 
     lemma comp_join:
     assumes "joinable (t \<cdot> u) (t \<cdot> u')"
     shows "composable t (u \<squnion> u')"
     and "t \<cdot> (u \<squnion> u') = t \<cdot> u \<squnion> t \<cdot> u'"
     proof -
       have "t \<lesssim> t \<cdot> u \<squnion> t \<cdot> u'"
         using assms
         by (metis composable_def composite_of_def join_of_def join_is_join_of
             joinable_implies_con prfx_transitive comp_is_composite_of(2) con_comp_iff)
       moreover have "(t \<cdot> u \<squnion> t \<cdot> u') \\ t = u \<squnion> u'"
         by (metis arr_resid_iff_con assms calculation comp_resid_prfx con_implies_arr(2)
             joinable_implies_con resid_join\<^sub>E(3) con_implies_arr(1) ide_implies_arr)
       ultimately show "t \<cdot> (u \<squnion> u') = t \<cdot> u \<squnion> t \<cdot> u'"
         by (metis comp_eqI)
       thus "composable t (u \<squnion> u')"
         by (metis assms joinable_iff_join_not_null comp_def)
     qed
 
     lemma join_src:
     assumes "arr t"
     shows "src t \<squnion> t = t"
       using assms joinable_def join_of_arr_src join_is_join_of join_of_unique src_in_sources
       by meson
 
     lemma join_self:
     assumes "arr t"
     shows "t \<squnion> t = t"
       using assms joinable_def join_of_arr_self join_is_join_of join_of_unique by blast
 
     lemma arr_prfx_join_self:
     assumes "joinable t u"
     shows "t \<lesssim> t \<squnion> u"
       using assms
       by (meson composite_of_def join_is_join_of join_of_def)
 
     text \<open>
       We note that it is not the case that the existence of either of \<open>t \<squnion> (u \<squnion> v)\<close>
       or \<open>(t \<squnion> u) \<squnion> v\<close> implies that of the other.  For example, if \<open>(t \<squnion> u) \<squnion> v \<noteq> null\<close>,
       then it is not necessarily the case that \<open>u \<squnion> v \<noteq> null\<close>.
     \<close>
 
+    lemma join_assoc:
+    assumes "joinable (t \<squnion> u) v" and "joinable t (u \<squnion> v)"
+    shows "t \<squnion> (u \<squnion> v) = (t \<squnion> u) \<squnion> v"
+    proof -
+      have vt_ut: "v \\ t \<frown> u \\ t"
+        using assms(1)
+        by (metis con_with_join_of_iff(2) join_def join_is_join_of joinable_implies_con
+            not_arr_null con_implies_arr(1))
+      have tv_uv: "t \\ v \<frown> u \\ v"
+        using vt_ut cube con_sym
+        by (metis arr_resid_iff_con)
+      have 2: "(t \<squnion> u) \<squnion> v = (t \<cdot> (u \\ t)) \<cdot> (v \\ (t \<cdot> (u \\ t)))"
+        using assms(1)
+        by (metis comp_is_composite_of(2) join_def join_is_join_of joinable_implies_con
+            not_arr_null con_implies_arr(1) join_ofE)
+      also have "... = t \<cdot> ((u \\ t) \<cdot> (v \\ (t \<cdot> (u \\ t))))"
+        using assms(1)
+        by (metis calculation comp_def joinable_iff_join_not_null comp_assoc)
+      also have "... = t \<cdot> ((u \\ t) \<cdot> ((v \\ t) \\ (u \\ t)))"
+        using assms(1)
+        by (metis "2" comp_null(2) con_sym joinable_iff_join_not_null resid_comp(1) conI)
+      also have "... = t \<cdot> ((v \\ t) \<squnion> (u \\ t))"
+      proof -
+        have "(v \\ t) \<squnion> (u \\ t) = (u \\ t) \<cdot> ((v \\ t) \\ (u \\ t))"
+          by (metis assms(2) comp_null(2) arr_comp comp_is_composite_of(2) con_comp_iff
+              join_is_join_of joinable_iff_join_not_null join_of_resid joinable_def
+              not_arr_null join_of_def joinable_implies_con)
+        thus ?thesis by simp
+      qed
+      also have "... = t \<cdot> ((u \\ t) \<squnion> (v \\ t))"
+        using join_sym by metis
+      also have "... = t \<cdot> ((u \<squnion> v) \\ t)"
+        by (metis assms(2) join_def resid_join\<^sub>E(3) joinable_implies_con null_is_zero(2) conE)
+      also have "... = t \<squnion> (u \<squnion> v)"
+        using assms(2) comp_is_composite_of(2) join_is_join_of by blast
+      finally show "t \<squnion> (u \<squnion> v) = (t \<squnion> u) \<squnion> v"
+        by simp
+    qed
+
   end
 
   subsubsection "Extensional RTS with Joins"
 
   locale extensional_rts_with_joins =
     rts_with_joins +
     extensional_rts
   begin
 
     lemma joinable_iff_con:
     shows "joinable t u \<longleftrightarrow> t \<frown> u"
       by (meson has_joins joinable_implies_con)
 
     lemma src_join\<^sub>E\<^sub>J [simp]:
     assumes "t \<frown> u"
     shows "src (t \<squnion> u) = src t"
       using assms
       by (meson has_joins src_join)
 
     lemma trg_join\<^sub>E\<^sub>J:
     assumes "t \<frown> u"
     shows "trg (t \<squnion> u) = trg (t \\ u)"
       using assms
       by (meson has_joins trg_join)
 
     lemma resid_join\<^sub>E\<^sub>J [simp]:
     assumes "t \<frown> u" and "v \<frown> t \<squnion> u"
     shows "v \\ (t \<squnion> u) = (v \\ t) \\ (u \\ t)"
     and "(t \<squnion> u) \\ v = (t \\ v) \<squnion> (u \\ v)"
       using assms has_joins resid_join\<^sub>E by blast+
 
-    lemma join_assoc:
+    lemma join_assoc\<^sub>E\<^sub>J:
     shows "t \<squnion> (u \<squnion> v) = (t \<squnion> u) \<squnion> v"
     proof -
       have *: "\<And>t u v. con (t \<squnion> u) v \<Longrightarrow> t \<squnion> (u \<squnion> v) = (t \<squnion> u) \<squnion> v"
       proof -
         fix t u v
         assume 1: "con (t \<squnion> u) v"
         have vt_ut: "v \\ t \<frown> u \\ t"
           using 1
           by (metis con_implies_arr(1) con_with_join_of_iff(2) join_is_join_of not_arr_null
               join_def)
         have tv_uv: "t \\ v \<frown> u \\ v"
           using vt_ut cube con_sym
           by (metis arr_resid_iff_con)
         have 2: "(t \<squnion> u) \<squnion> v = (t \<cdot> (u \\ t)) \<cdot> (v \\ (t \<cdot> (u \\ t)))"
           using 1
           by (metis comp_is_composite_of(2) con_implies_arr(1) has_joins join_is_join_of
                     join_of_def joinable_iff_arr_join)
         also have "... = t \<cdot> ((u \\ t) \<cdot> (v \\ (t \<cdot> (u \\ t))))"
           using 1
           by (metis calculation has_joins joinable_iff_join_not_null comp_assoc comp_def)
         also have "... = t \<cdot> ((u \\ t) \<cdot> ((v \\ t) \\ (u \\ t)))"
           using 1
           by (metis 2 comp_null(2) con_compI(2) con_comp_iff has_joins resid_comp(1)
               conI joinable_iff_join_not_null)
         also have "... = t \<cdot> ((v \\ t) \<squnion> (u \\ t))"
           by (metis vt_ut comp_is_composite_of(2) has_joins join_of_def join_is_join_of)
         also have "... = t \<cdot> ((u \\ t) \<squnion> (v \\ t))"
           using join_sym by metis
         also have "... = t \<cdot> ((u \<squnion> v) \\ t)"
           by (metis tv_uv vt_ut con_implies_arr(2) con_sym con_with_join_of_iff(1) has_joins
                     join_is_join_of arr_resid_iff_con resid_join\<^sub>E(3))
         also have "... = t \<squnion> (u \<squnion> v)"
           by (metis comp_is_composite_of(2) comp_null(2) conI has_joins join_is_join_of
               join_of_def joinable_iff_join_not_null)
         finally show "t \<squnion> (u \<squnion> v) = (t \<squnion> u) \<squnion> v"
           by simp
       qed
       thus ?thesis
         by (metis (full_types) has_joins joinable_iff_join_not_null joinable_implies_con con_sym)
     qed
 
     lemma join_is_lub:
     assumes "t \<lesssim> v" and "u \<lesssim> v"
     shows "t \<squnion> u \<lesssim> v"
     proof -
       have "(t \<squnion> u) \\ v = (t \\ v) \<squnion> (u \\ v)"
         using assms resid_join\<^sub>E(3) [of t u v]
-        by (metis arr_prfx_join_self con_target con_sym join_assoc joinable_iff_con
+        by (metis arr_prfx_join_self con_target con_sym join_assoc\<^sub>E\<^sub>J joinable_iff_con
             joinable_iff_join_not_null prfx_implies_con resid_reflects_con)
       also have "... = trg v \<squnion> trg v"
         using assms
         by (metis ideE prfx_implies_con src_resid trg_ide)
       also have "... = trg v"
         by (metis assms(2) ide_iff_src_self ide_implies_arr join_self prfx_implies_con
             src_resid)
       finally have "(t \<squnion> u) \\ v = trg v" by blast
       moreover have "ide (trg v)"
         using assms
         by (metis con_implies_arr(2) prfx_implies_con cong_char trg_def)
       ultimately show ?thesis by simp
     qed
         
   end
 
   subsubsection "Extensional RTS with Composites"
 
   text \<open>
     If an extensional RTS is assumed to have composites for all composable pairs of transitions,
     then the ``semantic'' property of transitions being composable can be replaced by the
     ``syntactic'' property of transitions being sequential.  This results in simpler
     statements of a number of properties.
   \<close>
 
   locale extensional_rts_with_composites =
     rts_with_composites +
     extensional_rts
   begin
 
     lemma seq_implies_arr_comp:
     assumes "seq t u"
     shows "arr (t \<cdot> u)"
       using assms
       by (meson composable_iff_arr_comp composable_iff_seq)
 
     lemma arr_comp\<^sub>E\<^sub>C [intro, simp]:
     assumes "arr t" and "arr u" and "trg t = src u"
     shows "arr (t \<cdot> u)"
       using assms
       by (simp add: seq_implies_arr_comp)
 
     lemma arr_compE\<^sub>E\<^sub>C [elim]:
     assumes "arr (t \<cdot> u)"
     and "\<lbrakk>arr t; arr u; trg t = src u\<rbrakk> \<Longrightarrow> T"
     shows T
       using assms composable_iff_arr_comp composable_iff_seq by blast
 
     lemma trg_comp\<^sub>E\<^sub>C [simp]:
     assumes "seq t u"
     shows "trg (t \<cdot> u) = trg u"
       by (meson assms has_composites trg_comp)
 
     lemma src_comp\<^sub>E\<^sub>C [simp]:
     assumes "seq t u"
     shows "src (t \<cdot> u) = src t"
       using assms src_comp has_composites by simp
 
     lemma con_comp_iff\<^sub>E\<^sub>C [simp]:
     shows "w \<frown> t \<cdot> u \<longleftrightarrow> seq t u \<and> u \<frown> w \\ t"
     and "t \<cdot> u \<frown> w \<longleftrightarrow> seq t u \<and> u \<frown> w \\ t"
       using composable_iff_seq con_comp_iff con_sym by meson+
 
     lemma comp_assoc\<^sub>E\<^sub>C:
     shows "t \<cdot> (u \<cdot> v) = (t \<cdot> u) \<cdot> v"
       apply (cases "seq t u")
        apply (metis arr_comp comp_assoc comp_def not_arr_null arr_compE\<^sub>E\<^sub>C arr_comp\<^sub>E\<^sub>C
                     seq_implies_arr_comp trg_comp\<^sub>E\<^sub>C)
       by (metis comp_def composable_iff_arr_comp seqI\<^sub>W\<^sub>E src_comp arr_compE\<^sub>E\<^sub>C)
 
     lemma diamond_commutes:
     shows "t \<cdot> (u \\ t) = u \<cdot> (t \\ u)"
     proof (cases "t \<frown> u")
       show "\<not> t \<frown> u \<Longrightarrow> ?thesis"
         by (metis comp_null(2) conI con_sym)
       assume con: "t \<frown> u"
       have "(t \<cdot> (u \\ t)) \\ u = (t \\ u) \<cdot> ((u \\ t) \\ (u \\ t))"
         using con
         by (metis (no_types, lifting) arr_resid_iff_con con_compI(2) con_implies_arr(1)
             resid_comp(2) con_imp_arr_resid con_sym comp_def arr_comp\<^sub>E\<^sub>C src_resid conI)
       moreover have "u \<lesssim> t \<cdot> (u \\ t)"
         by (metis arr_resid_iff_con calculation con cong_reflexive comp_arr_trg resid_arr_self
             resid_comp(1) trg_resid_sym)
       ultimately show ?thesis
         by (metis comp_eqI con comp_arr_trg resid_arr_self arr_resid trg_resid_sym)
     qed
 
     lemma mediating_transition:
     assumes "t \<cdot> v = u \<cdot> w"
     shows "v \\ (u \\ t) = w \\ (t \\ u)"
     proof (cases "seq t v")
       assume 1: "seq t v"
       hence 2: "arr (u \<cdot> w)"
         using assms by (metis arr_comp\<^sub>E\<^sub>C seqE\<^sub>W\<^sub>E)
       have 3: "v \\ (u \\ t) = ((t \<cdot> v) \\ t) \\ (u \\ t)"
         by (metis "1" comp_is_composite_of(1) composite_of_def obtains_composite_of extensional)
       also have "... = (t \<cdot> v) \\ (t \<cdot> (u \\ t))"
         by (metis (no_types, lifting) "2" assms con_comp_iff\<^sub>E\<^sub>C(2) con_imp_eq_src
             con_implies_arr(2) con_sym comp_resid_prfx prfx_comp resid_comp(1)
             arr_compE\<^sub>E\<^sub>C arr_comp\<^sub>E\<^sub>C prfx_implies_con)
       also have "... = (u \<cdot> w) \\ (u \<cdot> (t \\ u))"
         using assms diamond_commutes by presburger
       also have "... = ((u \<cdot> w) \\ u) \\ (t \\ u)"
         by (metis 3 assms calculation cube)
       also have "... = w \\ (t \\ u)"
         using 2 by simp
       finally show ?thesis by blast
       next
       assume 1: "\<not> seq t v"
       have "v \\ (u \\ t) = null"
         using 1
         by (metis (mono_tags, lifting) arr_resid_iff_con coinitial_iff\<^sub>W\<^sub>E con_imp_coinitial
             seqI\<^sub>W\<^sub>E src_resid conI)
       also have "... = w \\ (t \\ u)"
         by (metis (no_types, lifting) "1" arr_comp\<^sub>E\<^sub>C assms composable_imp_seq con_imp_eq_src
             con_implies_arr(1) con_implies_arr(2) comp_def not_arr_null conI src_resid)
       finally show ?thesis by blast
     qed
 
     lemma induced_arrow:
     assumes "seq t u" and "t \<cdot> u = t' \<cdot> u'"
     shows "(t' \\ t) \<cdot> (u \\ (t' \\ t)) = u"
     and "(t \\ t') \<cdot> (u \\ (t' \\ t)) = u'"
     and "(t' \\ t) \<cdot> v = u \<Longrightarrow> v = u \\ (t' \\ t)"
       apply (metis assms comp_eqI arr_compE\<^sub>E\<^sub>C prfx_comp resid_comp(1) arr_resid_iff_con
                    seq_implies_arr_comp)
        apply (metis assms comp_resid_prfx arr_compE\<^sub>E\<^sub>C resid_comp(2) arr_resid_iff_con
                     seq_implies_arr_comp)
       by (metis assms(1) comp_resid_prfx seq_def)
 
     text \<open>
       If an extensional RTS has composites, then it automatically has joins.
     \<close>
 
     sublocale extensional_rts_with_joins
     proof
       fix t u
       assume con: "t \<frown> u"
       have 1: "con u (t \<cdot> (u \\ t))"
         using con_compI(1) [of t "u \\ t" u]
         by (metis con con_implies_arr(1) con_sym diamond_commutes prfx_implies_con arr_resid
             prfx_comp src_resid arr_comp\<^sub>E\<^sub>C)
       have "t \<squnion> u = t \<cdot> (u \\ t)"
       proof (intro join_eqI)
         show "t \<lesssim> t \<cdot> (u \\ t)"
           by (metis 1 composable_def comp_is_composite_of(2) composite_of_def con_comp_iff)
         moreover show 2: "u \<lesssim> t \<cdot> (u \\ t)"
           using 1 arr_resid con con_sym prfx_reflexive resid_comp(1) by metis
         moreover show "(t \<cdot> (u \\ t)) \\ u = t \\ u"
           using 1 diamond_commutes induced_arrow(2) resid_comp(2) by force
         ultimately show "(t \<cdot> (u \\ t)) \\ t = u \\ t"
           by (metis con_comp_iff\<^sub>E\<^sub>C(1) con_sym prfx_implies_con resid_comp(2) induced_arrow(1))
       qed
       thus "joinable t u"
         by (metis "1" con_implies_arr(2) joinable_iff_join_not_null not_arr_null)
     qed
 
     lemma join_expansion:
     assumes "t \<frown> u"
     shows "t \<squnion> u = t \<cdot> (u \\ t)" and "seq t (u \\ t)"
     proof -
       show "t \<squnion> u = t \<cdot> (u \\ t)"
         by (metis assms comp_is_composite_of(2) has_joins join_is_join_of join_of_def)
       thus "seq t (u \\ t)"
         by (meson assms composable_def composable_iff_seq has_joins join_is_join_of join_of_def)
     qed
 
     lemma join3_expansion:
     assumes "t \<frown> u" and "t \<frown> v" and "u \<frown> v"
     shows "(t \<squnion> u) \<squnion> v = (t \<cdot> (u \\ t)) \<cdot> ((v \\ t) \\ (u \\ t))"
     proof (cases "v \\ t \<frown> u \\ t")
       show "\<not> v \\ t \<frown> u \\ t \<Longrightarrow> ?thesis"
         by (metis assms(1) comp_null(2) join_expansion(1) joinable_implies_con
             resid_comp(1) join_def conI)
       assume 1: "v \\ t \<frown> u \\ t "
       have "(t \<squnion> u) \<squnion> v = (t \<squnion> u) \<cdot> (v \\ (t \<squnion> u))"
         by (metis comp_null(1) diamond_commutes ex_un_null join_expansion(1)
             joinable_implies_con null_is_zero(2) join_def conI)
       also have "... = (t \<cdot> (u \\ t)) \<cdot> (v \\ (t \<squnion> u))"
         using join_expansion [of t u] assms(1) by presburger
       also have "... = (t \<cdot> (u \\ t)) \<cdot> ((v \\ u) \\ (t \\ u))"
         using assms 1 join_of_resid(1) [of t u v] cube [of v t u]
         by (metis con_compI(2) con_implies_arr(2) join_expansion(1) not_arr_null resid_comp(1)
             con_sym comp_def src_resid arr_comp\<^sub>E\<^sub>C)
       also have "... = (t \<cdot> (u \\ t)) \<cdot> ((v \\ t) \\ (u \\ t))"
         by (metis cube)
       finally show ?thesis by blast
     qed
 
     lemma resid_common_prefix:
     assumes "t \<cdot> u \<frown> t \<cdot> v"
     shows "(t \<cdot> u) \\ (t \<cdot> v) = u \\ v"
       using assms
       by (metis con_comp_iff con_sym con_comp_iff\<^sub>E\<^sub>C(2) con_implies_arr(2) induced_arrow(1)
           resid_comp(1) resid_comp(2) residuation.arr_resid_iff_con residuation_axioms)
 
   end
 
   subsection "Confluence"
 
   text \<open>
     An RTS is \emph{confluent} if every coinitial pair of transitions is consistent.
   \<close>
   
   locale confluent_rts = rts +
   assumes confluence: "coinitial t u \<Longrightarrow> con t u"
 
   section "Simulations"
 
   text \<open>
     \emph{Simulations} are morphism of residuated transition systems.
     They are assumed to preserve consistency and residuation.
   \<close>
 
   locale simulation =
     A: rts A +
     B: rts B
   for A :: "'a resid"      (infixr "\\\<^sub>A" 70)
   and B :: "'b resid"      (infixr "\\\<^sub>B" 70)
   and F :: "'a \<Rightarrow> 'b" +
   assumes extensional: "\<not> A.arr t \<Longrightarrow> F t = B.null"
   and preserves_con [simp]: "A.con t u \<Longrightarrow> B.con (F t) (F u)"
   and preserves_resid [simp]: "A.con t u \<Longrightarrow> F (t \\\<^sub>A u) = F t \\\<^sub>B F u"
   begin
 
     lemma preserves_reflects_arr [iff]:
     shows "B.arr (F t) \<longleftrightarrow> A.arr t"
       by (metis A.arr_def B.con_implies_arr(2) B.not_arr_null extensional preserves_con)
 
     lemma preserves_ide [simp]:
     assumes "A.ide a"
     shows "B.ide (F a)"
       by (metis A.ideE assms preserves_con preserves_resid B.ideI)
 
     lemma preserves_sources:
     shows "F ` A.sources t \<subseteq> B.sources (F t)"
       using A.sources_def B.sources_def preserves_con preserves_ide by auto
 
     lemma preserves_targets:
     shows "F ` A.targets t \<subseteq> B.targets (F t)"
       by (metis A.arrE B.arrE A.sources_resid B.sources_resid equals0D image_subset_iff
           A.arr_iff_has_target preserves_reflects_arr preserves_resid preserves_sources)
 
     lemma preserves_trg:
     assumes "A.arr t"
     shows "F (A.trg t) = B.trg (F t)"
       using assms A.trg_def B.trg_def by auto
 
     lemma preserves_composites:
     assumes "A.composite_of t u v"
     shows "B.composite_of (F t) (F u) (F v)"
       using assms
       by (metis A.composite_ofE A.prfx_implies_con B.composite_of_def preserves_ide
           preserves_resid A.con_sym)
 
     lemma preserves_joins:
     assumes "A.join_of t u v"
     shows "B.join_of (F t) (F u) (F v)"
       using assms A.join_of_def B.join_of_def A.joinable_def
       by (metis A.joinable_implies_con preserves_composites preserves_resid)
 
     lemma preserves_prfx:
     assumes "A.prfx t u"
     shows "B.prfx (F t) (F u)"
       using assms
       by (metis A.prfx_implies_con preserves_ide preserves_resid)
 
     lemma preserves_cong:
     assumes "A.cong t u"
     shows "B.cong (F t) (F u)"
       using assms preserves_prfx by simp
 
   end
 
   subsection "Identity Simulation"
 
   locale identity_simulation =
     rts
   begin
 
     abbreviation map
     where "map \<equiv> \<lambda>t. if arr t then t else null"
 
     sublocale simulation resid resid map
       using con_implies_arr con_sym arr_resid_iff_con
       by unfold_locales auto
 
   end
 
   subsection "Composite of Simulations"
 
   lemma simulation_comp:
   assumes "simulation A B F" and "simulation B C G"
   shows "simulation A C (G o F)"
   proof -
     interpret F: simulation A B F using assms(1) by auto
     interpret G: simulation B C G using assms(2) by auto
     show "simulation A C (G o F)"
       using F.extensional G.extensional by unfold_locales auto
   qed
 
   locale composite_simulation =
     F: simulation A B F +
     G: simulation B C G
   for A :: "'a resid"
   and B :: "'b resid"
   and C :: "'c resid"
   and F :: "'a \<Rightarrow> 'b"
   and G :: "'b \<Rightarrow> 'c"
   begin
 
     abbreviation map
     where "map \<equiv> G o F"
 
     sublocale simulation A C map
       using simulation_comp F.simulation_axioms G.simulation_axioms by blast
 
     lemma is_simulation:
     shows "simulation A C map"
       ..
 
   end
 
   subsection "Simulations into a Weakly Extensional RTS"
 
   locale simulation_to_weakly_extensional_rts =
     simulation +
     B: weakly_extensional_rts B
   begin
 
     lemma preserves_src:
-    shows "\<And>a. a \<in> A.sources t \<Longrightarrow> B.src (F t) = F a"
+    shows "a \<in> A.sources t \<Longrightarrow> B.src (F t) = F a"
       by (metis equals0D image_subset_iff B.arr_iff_has_source
           preserves_sources B.arr_has_un_source B.src_in_sources)
 
     lemma preserves_trg:
-    shows "\<And>b. b \<in> A.targets t \<Longrightarrow> B.trg (F t) = F b"
+    shows "b \<in> A.targets t \<Longrightarrow> B.trg (F t) = F b"
       by (metis equals0D image_subset_iff B.arr_iff_has_target
           preserves_targets B.arr_has_un_target B.trg_in_targets)
 
   end
 
   subsection "Simulations into an Extensional RTS"
 
   locale simulation_to_extensional_rts =
     simulation +
     B: extensional_rts B
   begin
 
     lemma preserves_comp:
     assumes "A.composite_of t u v"
     shows "F v = B.comp (F t) (F u)"
       using assms
       by (metis preserves_composites B.comp_is_composite_of(2))
 
     lemma preserves_join:
     assumes "A.join_of t u v"
     shows "F v = B.join (F t) (F u)"
       using assms preserves_joins
       by (meson B.join_is_join_of B.join_of_unique B.joinable_def)
 
   end
 
   subsection "Simulations between Extensional RTS's"
 
   locale simulation_between_extensional_rts =
     simulation_to_extensional_rts +
     A: extensional_rts A
   begin
 
     lemma preserves_src:
     shows "B.src (F t) = F (A.src t)"
       by (metis A.arr_src_iff_arr A.src_in_sources extensional image_subset_iff
           preserves_reflects_arr preserves_sources B.arr_has_un_source B.src_def
           B.src_in_sources)
 
     lemma preserves_trg:
     shows "B.trg (F t) = F (A.trg t)"
       by (metis A.arr_trg_iff_arr A.residuation_axioms A.trg_def B.null_is_zero(2) B.trg_def
           extensional preserves_resid residuation.arrE)
 
     lemma preserves_comp:
     assumes "A.composable t u"
     shows "F (A.comp t u) = B.comp (F t) (F u)"
       using assms
       by (metis A.arr_comp A.comp_resid_prfx A.composableD(2) A.not_arr_null
           A.prfx_comp A.residuation_axioms B.comp_eqI preserves_prfx preserves_resid
           residuation.conI)
 
     lemma preserves_join:
     assumes "A.joinable t u"
     shows "F (A.join t u) = B.join (F t) (F u)"
       using assms
       by (meson A.join_is_join_of B.joinable_def preserves_joins B.join_is_join_of
           B.join_of_unique)
 
   end
 
   subsection "Transformations"
 
   text \<open>
     A \emph{transformation} is a morphism of simulations, analogously to how a natural
     transformation is a morphism of functors, except the normal commutativity
     condition for that ``naturality squares'' is replaced by the requirement that
     the arrows at the apex of such a square are given by residuation of the
     arrows at the base.  If the codomain RTS is extensional, then this
     condition implies the commutativity of the square with respect to composition,
     as would be the case for a natural transformation between functors.
 
     The proper way to define a transformation when the domain and codomain are
     general RTS's is not yet clear to me.  However, if the domain and codomain are
     weakly extensional, then we have unique sources and targets, so there is no problem.
     The definition below is limited to that case.  I do not make any attempt here
     to develop facts about transformations.  My main reason for including this
     definition here is so that in the subsequent application to the \<open>\<lambda>\<close>-calculus,
     I can exhibit \<open>\<beta>\<close>-reduction as an example of a transformation.
   \<close>
 
   locale transformation =
     A: weakly_extensional_rts A +
     B: weakly_extensional_rts B +
     F: simulation A B F +
     G: simulation A B G
   for A :: "'a resid"      (infixr "\\\<^sub>A" 70)
   and B :: "'b resid"      (infixr "\\\<^sub>B" 70)
   and F :: "'a \<Rightarrow> 'b"
   and G :: "'a \<Rightarrow> 'b"
   and \<tau> :: "'a \<Rightarrow> 'b" +
   assumes extensional: "\<not> A.arr f \<Longrightarrow> \<tau> f = B.null"
   and preserves_src: "A.ide f \<Longrightarrow> B.src (\<tau> f) = F (A.src f)"
   and preserves_trg: "A.ide f \<Longrightarrow> B.trg (\<tau> f) = G (A.trg f)"
   and naturality1: "A.arr f \<Longrightarrow> \<tau> (A.src f) \\\<^sub>B F f = \<tau> (A.trg f)"
   and naturality2: "A.arr f \<Longrightarrow> F f \\\<^sub>B \<tau> (A.src f) = G f"
   and naturality3: "A.arr f \<Longrightarrow> B.join_of (\<tau> (A.src f)) (F f) (\<tau> f)"
 
   section "Normal Sub-RTS's and Congruence"
 
   text \<open>
     We now develop a general quotient construction on an RTS.
     We define a \emph{normal sub-RTS} of an RTS to be a collection of transitions \<open>\<NN>\<close> having
     certain ``local'' closure properties.  A normal sub-RTS induces an equivalence
     relation \<open>\<approx>\<^sub>0\<close>, which we call \emph{semi-congruence}, by defining \<open>t \<approx>\<^sub>0 u\<close> to hold exactly
     when \<open>t \ u\<close> and \<open>u \ t\<close> are both in \<open>\<NN>\<close>.  This relation generalizes the relation \<open>\<sim>\<close>
     defined for an arbitrary RTS, in the sense that \<open>\<sim>\<close> is obtained when \<open>\<NN>\<close> consists of
     all and only the identity transitions.  However, in general the relation \<open>\<approx>\<^sub>0\<close> is fully
     substitutive only in the left argument position of residuation; for the right argument position,
     a somewhat weaker property is satisfied.  We then coarsen \<open>\<approx>\<^sub>0\<close> to a relation \<open>\<approx>\<close>, by defining
     \<open>t \<approx> u\<close> to hold exactly when \<open>t\<close> and \<open>u\<close> can be transported by residuation along transitions
     in \<open>\<NN>\<close> to a common source, in such a way that the residuals are related by \<open>\<approx>\<^sub>0\<close>.
     To obtain full substitutivity of \<open>\<approx>\<close> with respect to residuation, we need to impose an
     additional condition on \<open>\<NN>\<close>.  This condition, which we call \emph{coherence},
     states that transporting a transition \<open>t\<close> along parallel transitions \<open>u\<close> and \<open>v\<close> in \<open>\<NN>\<close> always
     yields  residuals \<open>t \ u\<close> and \<open>u \ t\<close> that are related by \<open>\<approx>\<^sub>0\<close>.  We show that, under the
     assumption of coherence, the relation \<open>\<approx>\<close> is fully substitutive, and the quotient of the
     original RTS by this relation is an extensional RTS which has the \<open>\<NN>\<close>-connected components of
     the original RTS as identities.  Although the coherence property has a somewhat \emph{ad hoc}
     feel to it, we show that, in the context of the other conditions assumed for \<open>\<NN>\<close>, coherence is
     in fact equivalent to substitutivity for \<open>\<approx>\<close>.
   \<close>
 
   subsection "Normal Sub-RTS's"
 
   locale normal_sub_rts =
     R: rts +
     fixes \<NN> :: "'a set"
     assumes elements_are_arr: "t \<in> \<NN> \<Longrightarrow> R.arr t"
     and ide_closed: "R.ide a \<Longrightarrow> a \<in> \<NN>"
     and forward_stable: "\<lbrakk> u \<in> \<NN>; R.coinitial t u \<rbrakk> \<Longrightarrow> u \\ t \<in> \<NN>"
     and backward_stable: "\<lbrakk> u \<in> \<NN>; t \\ u \<in> \<NN> \<rbrakk> \<Longrightarrow> t \<in> \<NN>"
     and composite_closed_left: "\<lbrakk> u \<in> \<NN>; R.seq u t \<rbrakk> \<Longrightarrow> \<exists>v. R.composite_of u t v"
     and composite_closed_right: "\<lbrakk> u \<in> \<NN>; R.seq t u \<rbrakk> \<Longrightarrow> \<exists>v. R.composite_of t u v"
   begin
 
     lemma prfx_closed:
     assumes "u \<in> \<NN>" and "R.prfx t u"
     shows "t \<in> \<NN>"
       using assms backward_stable ide_closed by blast
 
     lemma composite_closed:
     assumes "t \<in> \<NN>" and "u \<in> \<NN>" and "R.composite_of t u v"
     shows "v \<in> \<NN>"
       using assms backward_stable R.composite_of_def prfx_closed by blast
 
     lemma factor_closed:
     assumes "R.composite_of t u v" and "v \<in> \<NN>"
     shows "t \<in> \<NN>" and "u \<in> \<NN>"
        apply (metis assms R.composite_of_def prfx_closed)
       by (meson assms R.composite_of_def R.con_imp_coinitial forward_stable prfx_closed
                 R.prfx_implies_con)
 
     lemma resid_along_elem_preserves_con:
     assumes "t \<frown> t'" and "R.coinitial t u" and "u \<in> \<NN>"
     shows "t \\ u \<frown> t' \\ u"
     proof -
       have "R.coinitial (t \\ t') (u \\ t')"
         by (metis assms R.arr_resid_iff_con R.coinitialI R.con_imp_common_source forward_stable
             elements_are_arr R.con_implies_arr(2) R.sources_resid R.sources_eqI)
       hence "t \\ t' \<frown> u \\ t'"
         by (metis assms(3) R.coinitial_iff R.con_imp_coinitial R.con_sym elements_are_arr
                   forward_stable R.arr_resid_iff_con)
       thus ?thesis
         using assms R.cube forward_stable by fastforce
     qed
 
   end
 
   subsubsection "Normal Sub-RTS's of an Extensional RTS with Composites"
 
   locale normal_in_extensional_rts_with_composites =
      R: extensional_rts +
      R: rts_with_composites +
      normal_sub_rts
   begin
 
     lemma factor_closed\<^sub>E\<^sub>C:
     assumes "t \<cdot> u \<in> \<NN>"
     shows "t \<in> \<NN>" and "u \<in> \<NN>"
       using assms factor_closed
       by (metis R.arrE R.composable_def R.comp_is_composite_of(2) R.con_comp_iff
                 elements_are_arr)+
 
     lemma comp_in_normal_iff:
     shows "t \<cdot> u \<in> \<NN> \<longleftrightarrow> t \<in> \<NN> \<and> u \<in> \<NN> \<and> R.seq t u"
       by (metis R.comp_is_composite_of(2) composite_closed elements_are_arr
           factor_closed(1-2) R.composable_def R.has_composites R.rts_with_composites_axioms
           R.extensional_rts_axioms extensional_rts_with_composites.arr_compE\<^sub>E\<^sub>C
           extensional_rts_with_composites_def R.seqI\<^sub>W\<^sub>E)
 
   end
 
   subsection "Semi-Congruence"
 
   context normal_sub_rts
   begin
 
     text \<open>
       We will refer to the elements of \<open>\<NN>\<close> as \emph{normal transitions}.
       Generalizing identity transitions to normal transitions in the definition of congruence,
       we obtain the notion of \emph{semi-congruence} of transitions with respect to a
       normal sub-RTS.
     \<close>
 
     abbreviation Cong\<^sub>0  (infix "\<approx>\<^sub>0" 50)
     where "t \<approx>\<^sub>0 t' \<equiv> t \\ t' \<in> \<NN> \<and> t' \\ t \<in> \<NN>"
 
     lemma Cong\<^sub>0_reflexive:
     assumes "R.arr t"
     shows "t \<approx>\<^sub>0 t"
       using assms R.cong_reflexive ide_closed by simp
 
     lemma Cong\<^sub>0_symmetric:
     assumes "t \<approx>\<^sub>0 t'"
     shows "t' \<approx>\<^sub>0 t"
       using assms by simp
 
     lemma Cong\<^sub>0_transitive [trans]:
     assumes "t \<approx>\<^sub>0 t'" and "t' \<approx>\<^sub>0 t''"
     shows "t \<approx>\<^sub>0 t''"
       by (metis (full_types) R.arr_resid_iff_con assms backward_stable forward_stable
           elements_are_arr R.coinitialI R.cube R.sources_resid)
 
     lemma Cong\<^sub>0_imp_con:
     assumes "t \<approx>\<^sub>0 t'"
     shows "R.con t t'"
       using assms R.arr_resid_iff_con elements_are_arr by blast
 
     lemma Cong\<^sub>0_imp_coinitial:
     assumes "t \<approx>\<^sub>0 t'"
     shows "R.sources t = R.sources t'"
       using assms by (meson Cong\<^sub>0_imp_con R.coinitial_iff R.con_imp_coinitial)
 
     text \<open>
       Semi-congruence is preserved and reflected by residuation along normal transitions.
     \<close>
 
     lemma Resid_along_normal_preserves_Cong\<^sub>0:
     assumes "t \<approx>\<^sub>0 t'" and "u \<in> \<NN>" and "R.sources t = R.sources u" 
     shows "t \\ u \<approx>\<^sub>0 t' \\ u"
       by (metis Cong\<^sub>0_imp_coinitial R.arr_resid_iff_con R.coinitialI R.coinitial_def
           R.cube R.sources_resid assms elements_are_arr forward_stable)
 
     lemma Resid_along_normal_reflects_Cong\<^sub>0:
     assumes "t \\ u \<approx>\<^sub>0 t' \\ u" and "u \<in> \<NN>"
     shows "t \<approx>\<^sub>0 t'"
       using assms
       by (metis backward_stable R.con_imp_coinitial R.cube R.null_is_zero(2)
                 forward_stable R.conI)
 
     text \<open>
       Semi-congruence is substitutive for the left-hand argument of residuation.
     \<close>
 
     lemma Cong\<^sub>0_subst_left:
     assumes "t \<approx>\<^sub>0 t'" and "t \<frown> u"
     shows "t' \<frown> u" and "t \\ u \<approx>\<^sub>0 t' \\ u"
     proof -
       have 1: "t \<frown> u \<and> t \<frown> t' \<and> u \\ t \<frown> t' \\ t"
         using assms
         by (metis Resid_along_normal_preserves_Cong\<^sub>0 Cong\<^sub>0_imp_con Cong\<^sub>0_reflexive R.con_sym
                   R.null_is_zero(2) R.arr_resid_iff_con R.sources_resid R.conI)
       hence 2: "t' \<frown> u \<and> u \\ t \<frown> t' \\ t \<and>
                 (t \\ u) \\ (t' \\ u) = (t \\ t') \\ (u \\ t') \<and>
                 (t' \\ u) \\ (t \\ u) = (t' \\ t) \\ (u \\ t)"
         by (meson R.con_sym R.cube R.resid_reflects_con)
       show "t' \<frown> u"
         using 2 by simp
       show "t \\ u \<approx>\<^sub>0 t' \\ u"
         using assms 1 2
         by (metis R.arr_resid_iff_con R.con_imp_coinitial R.cube forward_stable)
     qed
 
     text \<open>
       Semi-congruence is not exactly substitutive for residuation on the right.
       Instead, the following weaker property is satisfied.  Obtaining exact substitutivity
       on the right is the motivation for defining a coarser notion of congruence below.
     \<close>
 
     lemma Cong\<^sub>0_subst_right:
     assumes "u \<approx>\<^sub>0 u'" and "t \<frown> u"
     shows "t \<frown> u'" and "(t \\ u) \\ (u' \\ u) \<approx>\<^sub>0 (t \\ u') \\ (u \\ u')"
       using assms
        apply (meson Cong\<^sub>0_subst_left(1) R.con_sym)
       using assms
       by (metis R.sources_resid Cong\<^sub>0_imp_con Cong\<^sub>0_reflexive Resid_along_normal_preserves_Cong\<^sub>0
                 R.arr_resid_iff_con residuation.cube R.residuation_axioms)
 
     lemma Cong\<^sub>0_subst_Con:
     assumes "t \<approx>\<^sub>0 t'" and "u \<approx>\<^sub>0 u'"
     shows "t \<frown> u \<longleftrightarrow> t' \<frown> u'"
       using assms
       by (meson Cong\<^sub>0_subst_left(1) Cong\<^sub>0_subst_right(1))
 
     lemma Cong\<^sub>0_cancel_left:
     assumes "R.composite_of t u v" and "R.composite_of t u' v'" and "v \<approx>\<^sub>0 v'"
     shows "u \<approx>\<^sub>0 u'"
     proof -
       have "u \<approx>\<^sub>0 v \\ t"
         using assms(1) ide_closed by blast
       also have "v \\ t \<approx>\<^sub>0 v' \\ t"
         by (meson assms(1,3) Cong\<^sub>0_subst_left(2) R.composite_of_def R.con_sym R.prfx_implies_con)
       also have "v' \\ t \<approx>\<^sub>0 u'"
         using assms(2) ide_closed by blast
       finally show ?thesis by auto
     qed
 
     lemma Cong\<^sub>0_iff:
     shows "t \<approx>\<^sub>0 t' \<longleftrightarrow>
            (\<exists>u u' v v'. u \<in> \<NN> \<and> u' \<in> \<NN> \<and> v \<approx>\<^sub>0 v' \<and>
                         R.composite_of t u v \<and> R.composite_of t' u' v')"
     proof (intro iffI)
       show "\<exists>u u' v v'. u \<in> \<NN> \<and> u' \<in> \<NN> \<and> v \<approx>\<^sub>0 v' \<and>
                         R.composite_of t u v \<and> R.composite_of t' u' v'
                \<Longrightarrow> t \<approx>\<^sub>0 t'"
         by (meson Cong\<^sub>0_transitive R.composite_of_def ide_closed prfx_closed)
       show "t \<approx>\<^sub>0 t' \<Longrightarrow> \<exists>u u' v v'. u \<in> \<NN> \<and> u' \<in> \<NN> \<and> v \<approx>\<^sub>0 v' \<and>
                                     R.composite_of t u v \<and> R.composite_of t' u' v'"
         by (metis Cong\<^sub>0_imp_con Cong\<^sub>0_transitive R.composite_of_def R.prfx_reflexive
             R.arrI R.ideE)
     qed
 
     lemma diamond_commutes_upto_Cong\<^sub>0:
     assumes "t \<frown> u" and "R.composite_of t (u \\ t) v" and "R.composite_of u (t \\ u) v'"
     shows "v \<approx>\<^sub>0 v'"
     proof -
       have "v \\ v \<approx>\<^sub>0 v' \\ v \<and> v' \\ v' \<approx>\<^sub>0 v \\ v'"
       proof-
         have 1: "(v \\ t) \\ (u \\ t) \<approx>\<^sub>0 (v' \\ u) \\ (t \\ u)"
           using assms(2-3) R.cube [of v t u]
           by (metis R.con_target R.composite_ofE R.ide_imp_con_iff_cong ide_closed
               R.conI)
         have 2: "v \\ v \<approx>\<^sub>0 v' \\ v"
         proof -
           have "v \\ v \<approx>\<^sub>0 (v \\ t) \\ (u \\ t)"
             using assms R.composite_of_def ide_closed
             by (meson R.composite_of_unq_upto_cong R.prfx_implies_con R.resid_composite_of(3))
           also have "(v \\ t) \\ (u \\ t) \<approx>\<^sub>0 (v' \\ u) \\ (t \\ u)"
             using 1 by simp
           also have "(v' \\ u) \\ (t \\ u) \<approx>\<^sub>0 (v' \\ t) \\ (u \\ t)"
             by (metis "1" Cong\<^sub>0_transitive R.cube)
           also have "(v' \\ t) \\ (u \\ t) \<approx>\<^sub>0 v' \\ v"
             using assms R.composite_of_def ide_closed
             by (metis "1" R.conI R.con_sym_ax R.cube R.null_is_zero(2) R.resid_composite_of(3))
           finally show ?thesis by auto
         qed
         moreover have "v' \\ v' \<approx>\<^sub>0 v \\ v'"
         proof -
           have "v' \\ v' \<approx>\<^sub>0 (v' \\ u) \\ (t \\ u)"
             using assms R.composite_of_def ide_closed
             by (meson R.composite_of_unq_upto_cong R.prfx_implies_con R.resid_composite_of(3))
           also have "(v' \\ u) \\ (t \\ u) \<approx>\<^sub>0 (v \\ t) \\ (u \\ t)"
             using 1 by simp
           also have "(v \\ t) \\ (u \\ t) \<approx>\<^sub>0 (v \\ u) \\ (t \\ u)"
             using R.cube [of v t u] ide_closed
             by (metis Cong\<^sub>0_reflexive R.arr_resid_iff_con assms(2) R.composite_of_def
                       R.prfx_implies_con)
           also have "(v \\ u) \\ (t \\ u) \<approx>\<^sub>0 v \\ v'"
             using assms R.composite_of_def ide_closed
             by (metis 2 R.conI elements_are_arr R.not_arr_null R.null_is_zero(2)
                 R.resid_composite_of(3))
           finally show ?thesis by auto
         qed
         ultimately show ?thesis by blast
       qed
       thus ?thesis
         by (metis assms(2-3) R.composite_of_unq_upto_cong R.resid_arr_ide Cong\<^sub>0_imp_con)
     qed
 
     subsection "Congruence"
 
     text \<open>
       We use semi-congruence to define a coarser relation as follows.
     \<close>
 
     definition Cong  (infix "\<approx>" 50)
     where "Cong t t' \<equiv> \<exists>u u'. u \<in> \<NN> \<and> u' \<in> \<NN> \<and> t \\ u \<approx>\<^sub>0 t' \\ u'"
 
     lemma CongI [intro]:
     assumes "u \<in> \<NN>" and "u' \<in> \<NN>" and "t \\ u \<approx>\<^sub>0 t' \\ u'"
     shows "Cong t t'"
       using assms Cong_def by auto
 
     lemma CongE [elim]:
     assumes "t \<approx> t'"
     obtains u u'
     where "u \<in> \<NN>" and "u' \<in> \<NN>" and "t \\ u \<approx>\<^sub>0 t' \\ u'"
       using assms Cong_def by auto
 
     lemma Cong_imp_arr:
     assumes "t \<approx> t'"
     shows "R.arr t" and "R.arr t'"
       using assms Cong_def
       by (meson R.arr_resid_iff_con R.con_implies_arr(2) R.con_sym elements_are_arr)+
 
     lemma Cong_reflexive:
     assumes "R.arr t"
     shows "t \<approx> t"
       by (metis CongI Cong\<^sub>0_reflexive assms R.con_imp_coinitial_ax ide_closed
           R.resid_arr_ide R.arrE R.con_sym)
 
     lemma Cong_symmetric:
     assumes "t \<approx> t'"
     shows "t' \<approx> t"
       using assms Cong_def by auto
 
     text \<open>
       The existence of composites of normal transitions is used in the following.
     \<close>
 
     lemma Cong_transitive [trans]:
     assumes "t \<approx> t''" and "t'' \<approx> t'"
     shows "t \<approx> t'"
     proof -
       obtain u u'' where uu'': "u \<in> \<NN> \<and> u'' \<in> \<NN> \<and> t \\ u \<approx>\<^sub>0 t'' \\ u''"
         using assms Cong_def by blast
       obtain v' v'' where v'v'': "v' \<in> \<NN> \<and> v'' \<in> \<NN> \<and> t'' \\ v'' \<approx>\<^sub>0 t' \\ v'"
         using assms Cong_def by blast
       let ?w = "(t \\ u) \\ (v'' \\ u'')"
       let ?w' = "(t' \\ v') \\ (u'' \\ v'')"
       let ?w'' = "(t'' \\ v'') \\ (u'' \\ v'')"
       have w'': "?w'' = (t'' \\ u'') \\ (v'' \\ u'')"
         by (metis R.cube)
       have u''v'': "R.coinitial u'' v''"
         by (metis (full_types) R.coinitial_iff elements_are_arr R.con_imp_coinitial
             R.arr_resid_iff_con uu'' v'v'')
       hence v''u'': "R.coinitial v'' u''"
         by (meson R.con_imp_coinitial elements_are_arr forward_stable R.arr_resid_iff_con v'v'')
       have 1: "?w \\ ?w'' \<in> \<NN>"
       proof -
         have "(v'' \\ u'') \\ (t'' \\ u'') \<in> \<NN>"
           by (metis Cong\<^sub>0_transitive R.con_imp_coinitial forward_stable Cong\<^sub>0_imp_con
               resid_along_elem_preserves_con R.arrI R.arr_resid_iff_con u''v'' uu'' v'v'')
         thus ?thesis
           by (metis Cong\<^sub>0_subst_left(2) R.con_sym R.null_is_zero(1) uu'' w'' R.conI)
       qed
       have 2: "?w'' \\ ?w \<in> \<NN>"
         by (metis 1 Cong\<^sub>0_subst_left(2) uu'' w'' R.conI)
       have 3: "R.seq u (v'' \\ u'')"
         by (metis (full_types) 2 Cong\<^sub>0_imp_coinitial R.sources_resid
             Cong\<^sub>0_imp_con R.arr_resid_iff_con R.con_implies_arr(2) R.seqI uu'' R.conI)
       have 4: "R.seq v' (u'' \\ v'')"
         by (metis 1 Cong\<^sub>0_imp_coinitial Cong\<^sub>0_imp_con R.arr_resid_iff_con
             R.con_implies_arr(2) R.seq_def R.sources_resid v'v'' R.conI)
       obtain x where x: "R.composite_of u (v'' \\ u'') x"
         using 3 composite_closed_left uu'' by blast
       obtain x' where x': "R.composite_of v' (u'' \\ v'') x'"
         using 4 composite_closed_left v'v'' by presburger
       have "?w \<approx>\<^sub>0 ?w'"
       proof -
         have "?w \<approx>\<^sub>0 ?w'' \<and> ?w' \<approx>\<^sub>0 ?w''"
           using 1 2
           by (metis Cong\<^sub>0_subst_left(2) R.null_is_zero(2) v'v'' R.conI)
         thus ?thesis
           using Cong\<^sub>0_transitive by blast
       qed
       moreover have "x \<in> \<NN> \<and> ?w \<approx>\<^sub>0 t \\ x"
         apply (intro conjI)
           apply (meson composite_closed forward_stable u''v'' uu'' v'v'' x)
          apply (metis (full_types) R.arr_resid_iff_con R.con_implies_arr(2) R.con_sym
             ide_closed forward_stable R.composite_of_def R.resid_composite_of(3)
             Cong\<^sub>0_subst_right(1) prfx_closed u''v'' uu'' v'v'' x R.conI)
         by (metis (no_types, lifting) 1 R.con_composite_of_iff ide_closed 
             R.resid_composite_of(3) R.arr_resid_iff_con R.con_implies_arr(1) R.con_sym x R.conI)
       moreover have "x' \<in> \<NN> \<and> ?w' \<approx>\<^sub>0 t' \\ x'"
         apply (intro conjI)
           apply (meson composite_closed forward_stable uu'' v''u'' v'v'' x')
          apply (metis (full_types) Cong\<^sub>0_subst_right(1) R.composite_ofE R.con_sym
             ide_closed forward_stable R.con_imp_coinitial prfx_closed
             R.resid_composite_of(3) R.arr_resid_iff_con R.con_implies_arr(1) uu'' v'v'' x' R.conI)
         by (metis (full_types) Cong\<^sub>0_subst_left(1) R.composite_ofE R.con_sym ide_closed
             forward_stable R.con_imp_coinitial prfx_closed R.resid_composite_of(3)
             R.arr_resid_iff_con R.con_implies_arr(1) uu'' v'v'' x' R.conI)
       ultimately show "t \<approx> t'"
         using Cong_def Cong\<^sub>0_transitive by metis
     qed
 
     lemma Cong_closure_props:
     shows "t \<approx> u \<Longrightarrow> u \<approx> t"
     and "\<lbrakk>t \<approx> u; u \<approx> v\<rbrakk> \<Longrightarrow> t \<approx> v"
     and "t \<approx>\<^sub>0 u \<Longrightarrow> t \<approx> u"
     and "\<lbrakk>u \<in> \<NN>; R.sources t = R.sources u\<rbrakk> \<Longrightarrow> t \<approx> t \\ u"
     proof -
       show "t \<approx> u \<Longrightarrow> u \<approx> t"
         using Cong_symmetric by blast
       show "\<lbrakk>t \<approx> u; u \<approx> v\<rbrakk> \<Longrightarrow> t \<approx> v"
         using Cong_transitive by blast
       show "t \<approx>\<^sub>0 u \<Longrightarrow> t \<approx> u"
         by (metis Cong\<^sub>0_subst_left(2) Cong_def Cong_reflexive R.con_implies_arr(1)
             R.null_is_zero(2) R.conI)
       show "\<lbrakk>u \<in> \<NN>; R.sources t = R.sources u\<rbrakk> \<Longrightarrow> t \<approx> t \\ u"
       proof -
         assume u: "u \<in> \<NN>" and coinitial: "R.sources t = R.sources u"
         obtain a where a: "a \<in> R.targets u"
           by (meson elements_are_arr empty_subsetI R.arr_iff_has_target subsetI subset_antisym u)
         have "t \\ u \<approx>\<^sub>0 (t \\ u) \\ a"
         proof -
           have "R.arr t"
             using R.arr_iff_has_source coinitial elements_are_arr u by presburger
           thus ?thesis
             by (meson u a R.arr_resid_iff_con coinitial ide_closed forward_stable
                 elements_are_arr R.coinitial_iff R.composite_of_arr_target R.resid_composite_of(3))
         qed
         thus ?thesis
           using Cong_def
           by (metis a R.composite_of_arr_target elements_are_arr factor_closed(2) u)
       qed
     qed
 
     lemma Cong\<^sub>0_implies_Cong:
     assumes "t \<approx>\<^sub>0 t'"
     shows "t \<approx> t'"
       using assms Cong_closure_props(3) by simp
 
     lemma in_sources_respects_Cong:
     assumes "t \<approx> t'" and "a \<in> R.sources t" and "a' \<in> R.sources t'"
     shows "a \<approx> a'"
     proof -
       obtain u u' where uu': "u \<in> \<NN> \<and> u' \<in> \<NN> \<and> t \\ u \<approx>\<^sub>0 t' \\ u'"
         using assms Cong_def by blast
       show "a \<approx> a'"
       proof
         show "u \<in> \<NN>"
           using uu' by simp
         show "u' \<in> \<NN>"
           using uu' by simp
         show "a \\ u \<approx>\<^sub>0 a' \\ u'"
         proof -
           have "a \\ u \<in> R.targets u"
             by (metis Cong\<^sub>0_imp_con R.arr_resid_iff_con assms(2) R.con_imp_common_source
                 R.con_implies_arr(1) R.resid_source_in_targets R.sources_eqI uu')
           moreover have "a' \\ u' \<in> R.targets u'"
             by (metis Cong\<^sub>0_imp_con R.arr_resid_iff_con assms(3) R.con_imp_common_source
                 R.resid_source_in_targets R.con_implies_arr(1) R.sources_eqI uu')
           moreover have "R.targets u = R.targets u'"
             by (metis Cong\<^sub>0_imp_coinitial Cong\<^sub>0_imp_con R.arr_resid_iff_con
                 R.con_implies_arr(1) R.sources_resid uu')
           ultimately show ?thesis
             using ide_closed R.targets_are_cong by presburger
         qed
       qed
     qed
 
     lemma in_targets_respects_Cong:
     assumes "t \<approx> t'" and "b \<in> R.targets t" and "b' \<in> R.targets t'"
     shows "b \<approx> b'"
     proof -
       obtain u u' where uu': "u \<in> \<NN> \<and> u' \<in> \<NN> \<and> t \\ u \<approx>\<^sub>0 t' \\ u'"
         using assms Cong_def by blast
       have seq: "R.seq (u \\ t) ((t' \\ u') \\ (t \\ u)) \<and> R.seq (u' \\ t') ((t \\ u) \\ (t' \\ u'))"
         by (metis R.arr_iff_has_source R.arr_iff_has_target R.conI elements_are_arr R.not_arr_null
             R.seqI R.sources_resid R.targets_resid_sym uu')
       obtain v where v: "R.composite_of (u \\ t) ((t' \\ u') \\ (t \\ u)) v"
         using seq composite_closed_right uu' by presburger
       obtain v' where v': "R.composite_of (u' \\ t') ((t \\ u) \\ (t' \\ u')) v'"
         using seq composite_closed_right uu' by presburger
       show "b \<approx> b'"
       proof
         show v_in_\<NN>: "v \<in> \<NN>"
           by (metis composite_closed R.con_imp_coinitial R.con_implies_arr(1) forward_stable
               R.composite_of_def R.prfx_implies_con R.arr_resid_iff_con R.con_sym uu' v)
         show v'_in_\<NN>: "v' \<in> \<NN>"
           by (metis backward_stable R.composite_of_def R.con_imp_coinitial forward_stable
               R.null_is_zero(2) prfx_closed uu' v' R.conI)
         show "b \\ v \<approx>\<^sub>0 b' \\ v'"
           using assms uu' v v'
           by (metis R.arr_resid_iff_con ide_closed R.seq_def R.sources_resid R.targets_resid_sym
               R.resid_source_in_targets seq R.sources_composite_of R.targets_are_cong
               R.targets_composite_of)
       qed
     qed
 
     lemma sources_are_Cong:
     assumes "a \<in> R.sources t" and "a' \<in> R.sources t"
     shows "a \<approx> a'"
       using assms
       by (simp add: ide_closed R.sources_are_cong Cong_closure_props(3))
 
     lemma targets_are_Cong:
     assumes "b \<in> R.targets t" and "b' \<in> R.targets t"
     shows "b \<approx> b'"
       using assms
       by (simp add: ide_closed R.targets_are_cong Cong_closure_props(3))
 
     text \<open>
       It is \emph{not} the case that sources and targets are \<open>\<approx>\<close>-closed;
       \emph{i.e.} \<open>t \<approx> t' \<Longrightarrow> sources t = sources t'\<close> and \<open>t \<approx> t' \<Longrightarrow> targets t = targets t'\<close>
       do not hold, in general.
     \<close>
 
     lemma Resid_along_normal_preserves_reflects_con:
     assumes "u \<in> \<NN>" and "R.sources t = R.sources u"
     shows "t \\ u \<frown> t' \\ u \<longleftrightarrow> t \<frown> t'"
       by (metis R.arr_resid_iff_con assms R.con_implies_arr(1-2) elements_are_arr R.coinitial_iff
                 R.resid_reflects_con resid_along_elem_preserves_con)
 
     text \<open>
       We can alternatively characterize \<open>\<approx>\<close> as the least symmetric and transitive
       relation on transitions that extends \<open>\<approx>\<^sub>0\<close> and has the property
       of being preserved by residuation along transitions in \<open>\<NN>\<close>.
     \<close>
 
     inductive Cong'
     where "\<And>t u. Cong' t u \<Longrightarrow> Cong' u t"
         | "\<And>t u v. \<lbrakk>Cong' t u; Cong' u v\<rbrakk> \<Longrightarrow> Cong' t v"
         | "\<And>t u. t \<approx>\<^sub>0 u \<Longrightarrow> Cong' t u"
         | "\<And>t u. \<lbrakk>R.arr t; u \<in> \<NN>; R.sources t = R.sources u\<rbrakk> \<Longrightarrow> Cong' t (t \\ u)"
 
     lemma Cong'_if:
     shows "\<lbrakk>u \<in> \<NN>; u' \<in> \<NN>; t \\ u \<approx>\<^sub>0 t' \\ u'\<rbrakk> \<Longrightarrow> Cong' t t'"
     proof -
       assume u: "u \<in> \<NN>" and u': "u' \<in> \<NN>" and 1: "t \\ u \<approx>\<^sub>0 t' \\ u'"
       show "Cong' t t'"
         using u u' 1
         by (metis (no_types, lifting) Cong'.simps Cong\<^sub>0_imp_con R.arr_resid_iff_con
             R.coinitial_iff R.con_imp_coinitial)
     qed
 
     lemma Cong_char:
     shows "Cong t t' \<longleftrightarrow> Cong' t t'"
     proof -
       have "Cong t t' \<Longrightarrow> Cong' t t'"
         using Cong_def Cong'_if by blast
       moreover have "Cong' t t' \<Longrightarrow> Cong t t'"
         apply (induction rule: Cong'.induct)
         using Cong_symmetric apply simp
         using Cong_transitive apply simp
         using Cong_closure_props(3) apply simp
         using Cong_closure_props(4) by simp
       ultimately show ?thesis
         using Cong_def by blast
     qed
 
     lemma normal_is_Cong_closed:
     assumes "t \<in> \<NN>" and "t \<approx> t'"
     shows "t' \<in> \<NN>"
       using assms
       by (metis (full_types) CongE R.con_imp_coinitial forward_stable
           R.null_is_zero(2) backward_stable R.conI)
 
     subsection "Congruence Classes"
 
     text \<open>
       Here we develop some notions relating to the congruence classes of \<open>\<approx>\<close>.
     \<close>
 
     definition Cong_class ("\<lbrace>_\<rbrace>")
     where "Cong_class t \<equiv> {t'. t \<approx> t'}"
 
     definition is_Cong_class
     where "is_Cong_class \<T> \<equiv> \<exists>t. t \<in> \<T> \<and> \<T> = \<lbrace>t\<rbrace>"
 
     definition Cong_class_rep
     where "Cong_class_rep \<T> \<equiv> SOME t. t \<in> \<T>"
 
     lemma Cong_class_is_nonempty:
     assumes "is_Cong_class \<T>"
     shows "\<T> \<noteq> {}"
       using assms is_Cong_class_def Cong_class_def by auto
 
     lemma rep_in_Cong_class:
     assumes "is_Cong_class \<T>"
     shows "Cong_class_rep \<T> \<in> \<T>"
       using assms is_Cong_class_def Cong_class_rep_def someI_ex [of "\<lambda>t. t \<in> \<T>"]
       by metis
 
     lemma arr_in_Cong_class:
     assumes "R.arr t"
     shows "t \<in> \<lbrace>t\<rbrace>"
       using assms Cong_class_def Cong_reflexive by simp
 
     lemma is_Cong_classI:
     assumes "R.arr t"
     shows "is_Cong_class \<lbrace>t\<rbrace>"
       using assms Cong_class_def is_Cong_class_def Cong_reflexive by blast
 
     lemma is_Cong_classI' [intro]:
     assumes "\<T> \<noteq> {}"
     and "\<And>t t'. \<lbrakk>t \<in> \<T>; t' \<in> \<T>\<rbrakk> \<Longrightarrow> t \<approx> t'"
     and "\<And>t t'. \<lbrakk>t \<in> \<T>; t' \<approx> t\<rbrakk> \<Longrightarrow> t' \<in> \<T>"
     shows "is_Cong_class \<T>"
     proof -
       obtain t where t: "t \<in> \<T>"
         using assms by auto
       have "\<T> = \<lbrace>t\<rbrace>"
         unfolding Cong_class_def
         using assms(2-3) t by blast
       thus ?thesis
         using is_Cong_class_def t by blast
     qed
 
     lemma Cong_class_memb_is_arr:
     assumes "is_Cong_class \<T>" and "t \<in> \<T>"
     shows "R.arr t"
       using assms Cong_class_def is_Cong_class_def Cong_imp_arr(2) by force
 
     lemma Cong_class_membs_are_Cong:
     assumes "is_Cong_class \<T>" and "t \<in> \<T>" and "t' \<in> \<T>"
     shows "Cong t t'"
       using assms Cong_class_def is_Cong_class_def
       by (metis CollectD Cong_closure_props(2) Cong_symmetric)
 
     lemma Cong_class_eqI:
     assumes "t \<approx> t'"
     shows "\<lbrace>t\<rbrace> = \<lbrace>t'\<rbrace>"
       using assms Cong_class_def
       by (metis (full_types) Collect_cong Cong'.intros(1-2) Cong_char)
 
     lemma Cong_class_eqI':
     assumes "is_Cong_class \<T>" and "is_Cong_class \<U>" and "\<T> \<inter> \<U> \<noteq> {}"
     shows "\<T> = \<U>"
       using assms is_Cong_class_def Cong_class_eqI Cong_class_membs_are_Cong
       by (metis (no_types, lifting) Int_emptyI)
 
     lemma is_Cong_classE [elim]:
     assumes "is_Cong_class \<T>"
     and "\<lbrakk>\<T> \<noteq> {}; \<And>t t'. \<lbrakk>t \<in> \<T>; t' \<in> \<T>\<rbrakk> \<Longrightarrow> t \<approx> t'; \<And>t t'. \<lbrakk>t \<in> \<T>; t' \<approx> t\<rbrakk> \<Longrightarrow> t' \<in> \<T>\<rbrakk> \<Longrightarrow> T"
     shows T
     proof -
       have \<T>: "\<T> \<noteq> {}"
         using assms Cong_class_is_nonempty by simp
       moreover have 1: "\<And>t t'. \<lbrakk>t \<in> \<T>; t' \<in> \<T>\<rbrakk> \<Longrightarrow> t \<approx> t'"
         using assms Cong_class_membs_are_Cong by metis
       moreover have "\<And>t t'. \<lbrakk>t \<in> \<T>; t' \<approx> t\<rbrakk> \<Longrightarrow> t' \<in> \<T>"
         using assms Cong_class_def
         by (metis 1 Cong_class_eqI Cong_imp_arr(1) is_Cong_class_def arr_in_Cong_class)
       ultimately show ?thesis
         using assms by blast
     qed
 
     lemma Cong_class_rep [simp]:
     assumes "is_Cong_class \<T>"
     shows "\<lbrace>Cong_class_rep \<T>\<rbrace> = \<T>"
       by (metis Cong_class_membs_are_Cong Cong_class_eqI assms is_Cong_class_def rep_in_Cong_class)
 
     lemma Cong_class_memb_Cong_rep:
     assumes "is_Cong_class \<T>" and "t \<in> \<T>"
     shows "Cong t (Cong_class_rep \<T>)"
       using assms Cong_class_membs_are_Cong rep_in_Cong_class by simp
 
     lemma composite_of_normal_arr:
     shows "\<lbrakk> R.arr t; u \<in> \<NN>; R.composite_of u t t' \<rbrakk> \<Longrightarrow> t' \<approx> t"
       by (meson Cong'.intros(3) Cong_char R.composite_of_def R.con_implies_arr(2)
                 ide_closed R.prfx_implies_con Cong_closure_props(2,4) R.sources_composite_of)
 
     lemma composite_of_arr_normal:
     shows "\<lbrakk> arr t; u \<in> \<NN>; R.composite_of t u t' \<rbrakk> \<Longrightarrow> t' \<approx>\<^sub>0 t"
       by (meson Cong_closure_props(3) R.composite_of_def ide_closed prfx_closed)
 
   end
 
   subsection "Coherent Normal Sub-RTS's"
 
   text \<open>
     A \emph{coherent} normal sub-RTS is one that satisfies a parallel moves property with respect
     to arbitrary transitions.  The congruence \<open>\<approx>\<close> induced by a coherent normal sub-RTS is
     fully substitutive with respect to consistency and residuation,
     and in fact coherence is equivalent to substitutivity in this context.
   \<close>
 
   locale coherent_normal_sub_rts = normal_sub_rts +
     assumes coherent: "\<lbrakk> R.arr t; u \<in> \<NN>; u' \<in> \<NN>; R.sources u = R.sources u';
                          R.targets u = R.targets u'; R.sources t = R.sources u \<rbrakk>
                             \<Longrightarrow> t \\ u \<approx>\<^sub>0 t \\ u'"
 
   (*
    * TODO: Should coherence be part of normality, or is it an additional property that guarantees
    * the existence of the quotient?
    *
    * e.g. see http://nlab-pages.s3.us-east-2.amazonaws.com/nlab/show/normal+subobject
    * Maybe also http://www.tac.mta.ca/tac/volumes/36/3/36-03.pdf for recent work.
    *)
 
   context normal_sub_rts
   begin
 
     text \<open>
       The above ``parallel moves'' formulation of coherence is equivalent to the following
       formulation, which involves ``opposing spans''.
     \<close>
 
     lemma coherent_iff:
     shows "(\<forall>t u u'. R.arr t \<and> u \<in> \<NN> \<and> u' \<in> \<NN> \<and> R.sources t = R.sources u \<and>
                      R.sources u = R.sources u' \<and> R.targets u = R.targets u'
                             \<longrightarrow> t \\ u \<approx>\<^sub>0 t \\ u')
            \<longleftrightarrow>
            (\<forall>t t' v v' w w'. v \<in> \<NN> \<and> v' \<in> \<NN> \<and> w \<in> \<NN> \<and> w' \<in> \<NN> \<and>
                              R.sources v = R.sources w \<and> R.sources v' = R.sources w' \<and>
                              R.targets w = R.targets w' \<and> t \\ v \<approx>\<^sub>0 t' \\ v'
                                 \<longrightarrow> t \\ w \<approx>\<^sub>0 t' \\ w')"
     proof
       assume 1: "\<forall>t t' v v' w w'. v \<in> \<NN> \<and> v' \<in> \<NN> \<and> w \<in> \<NN> \<and> w' \<in> \<NN> \<and>
                              R.sources v = R.sources w \<and> R.sources v' = R.sources w' \<and>
                              R.targets w = R.targets w' \<and> t \\ v \<approx>\<^sub>0 t' \\ v'
                                 \<longrightarrow> t \\ w \<approx>\<^sub>0 t' \\ w'"
       show "\<forall>t u u'. R.arr t \<and> u \<in> \<NN> \<and> u' \<in> \<NN> \<and> R.sources t = R.sources u \<and>
                      R.sources u = R.sources u' \<and> R.targets u = R.targets u'
                             \<longrightarrow> t \\ u \<approx>\<^sub>0 t \\ u'"
       proof (intro allI impI, elim conjE)
         fix t u u'
         assume t: "R.arr t" and u: "u \<in> \<NN>" and u': "u' \<in> \<NN>"
         and tu: "R.sources t = R.sources u" and sources: "R.sources u = R.sources u'"
         and targets: "R.targets u = R.targets u'"
         show "t \\ u \<approx>\<^sub>0 t \\ u'"
           by (metis 1 Cong\<^sub>0_reflexive Resid_along_normal_preserves_Cong\<^sub>0 sources t targets
               tu u u')
       qed
       next
       assume 1: "\<forall>t u u'. R.arr t \<and> u \<in> \<NN> \<and> u' \<in> \<NN> \<and> R.sources t = R.sources u \<and>
                      R.sources u = R.sources u' \<and> R.targets u = R.targets u'
                             \<longrightarrow> t \\ u \<approx>\<^sub>0 t \\ u'"
       show "\<forall>t t' v v' w w'. v \<in> \<NN> \<and> v' \<in> \<NN> \<and> w \<in> \<NN> \<and> w' \<in> \<NN> \<and>
                              R.sources v = R.sources w \<and> R.sources v' = R.sources w' \<and>
                              R.targets w = R.targets w' \<and> t \\ v \<approx>\<^sub>0 t' \\ v'
                                 \<longrightarrow> t \\ w \<approx>\<^sub>0 t' \\ w'"
       proof (intro allI impI, elim conjE)
         fix t t' v v' w w'
         assume v: "v \<in> \<NN>" and v': "v' \<in> \<NN>" and w: "w \<in> \<NN>" and w': "w' \<in> \<NN>"
         and vw: "R.sources v = R.sources w" and v'w': "R.sources v' = R.sources w'"
         and ww': "R.targets w = R.targets w'"
         and tvt'v': "(t \\ v) \\ (t' \\ v') \<in> \<NN>" and t'v'tv: "(t' \\ v') \\ (t \\ v) \<in> \<NN>"
         show "t \\ w \<approx>\<^sub>0 t' \\ w'"
         proof -
           have 3: "R.sources t = R.sources v \<and> R.sources t' = R.sources v'"
             using R.con_imp_coinitial
             by (meson Cong\<^sub>0_imp_con tvt'v' t'v'tv
                 R.coinitial_iff R.arr_resid_iff_con)
           have 2: "t \\ w \<approx> t' \\ w'"
             using Cong_closure_props
             by (metis tvt'v' t'v'tv 3 vw v'w' v v' w w')
           obtain z z' where zz': "z \<in> \<NN> \<and> z' \<in> \<NN> \<and> (t \\ w) \\ z \<approx>\<^sub>0 (t' \\ w') \\ z'"
             using 2 by auto
           have "(t \\ w) \\ z \<approx>\<^sub>0 (t \\ w) \\ z'"
           proof -
             have "R.coinitial ((t \\ w) \\ z) ((t \\ w) \\ z')"
               by (metis Cong\<^sub>0_imp_coinitial Cong_imp_arr(1)
                   Resid_along_normal_preserves_reflects_con R.arr_def R.coinitialI
                   R.con_imp_common_source Cong_closure_props(3) R.arr_resid_iff_con R.sources_eqI
                   R.sources_resid ww' zz')
             thus ?thesis
               apply (intro conjI)
               by (metis 1 R.coinitial_iff R.con_imp_coinitial R.arr_resid_iff_con
                         R.sources_resid zz')+
           qed
           hence "(t \\ w) \\ z' \<approx>\<^sub>0 (t' \\ w') \\ z'"
             using zz' Cong\<^sub>0_transitive Cong\<^sub>0_symmetric by blast
           thus ?thesis
             using zz' Resid_along_normal_reflects_Cong\<^sub>0 by metis
         qed
       qed
     qed
 
   end
 
   context coherent_normal_sub_rts
   begin
 
     text \<open>
       The proof of the substitutivity of \<open>\<approx>\<close> with respect to residuation only uses
       coherence in the ``opposing spans'' form.
     \<close>
 
     lemma coherent':
     assumes "v \<in> \<NN>" and "v' \<in> \<NN>" and "w \<in> \<NN>" and "w' \<in> \<NN>"
     and "R.sources v = R.sources w" and "R.sources v' = R.sources w'"
     and "R.targets w = R.targets w'" and "t \\ v \<approx>\<^sub>0 t' \\ v'"
     shows "t \\ w \<approx>\<^sub>0 t' \\ w'"
       using assms coherent coherent_iff by metis  (* 6 sec *)
 
     text \<open>
       The relation \<open>\<approx>\<close> is substitutive with respect to both arguments of residuation.
     \<close>
 
     lemma Cong_subst:
     assumes "t \<approx> t'" and "u \<approx> u'" and "t \<frown> u" and "R.sources t' = R.sources u'"
     shows "t' \<frown> u'" and "t \\ u \<approx> t' \\ u'"
     proof -
       obtain v v' where vv': "v \<in> \<NN> \<and> v' \<in> \<NN> \<and> t \\ v \<approx>\<^sub>0 t' \\ v'"
         using assms by auto
       obtain w w' where ww': "w \<in> \<NN> \<and> w' \<in> \<NN> \<and> u \\ w \<approx>\<^sub>0 u' \\ w'"
         using assms by auto
       let ?x = "t \\ v" and ?x' = "t' \\ v'"
       let ?y = "u \\ w" and ?y' = "u' \\ w'"
       have xx': "?x \<approx>\<^sub>0 ?x'"
         using assms vv' by blast
       have yy': "?y \<approx>\<^sub>0 ?y'"
         using assms ww' by blast
       have 1: "t \\ w \<approx>\<^sub>0 t' \\ w'"
       proof -
         have "R.sources v = R.sources w"
           by (metis (no_types, lifting) Cong\<^sub>0_imp_con R.arr_resid_iff_con assms(3)
               R.con_imp_common_source R.con_implies_arr(2) R.sources_eqI ww' xx')
         moreover have "R.sources v' = R.sources w'"
           by (metis (no_types, lifting) assms(4) R.coinitial_iff R.con_imp_coinitial
               Cong\<^sub>0_imp_con R.arr_resid_iff_con ww' xx')
         moreover have "R.targets w = R.targets w'"
           by (metis Cong\<^sub>0_implies_Cong Cong\<^sub>0_imp_coinitial Cong_imp_arr(1)
               R.arr_resid_iff_con R.sources_resid ww')
         ultimately show ?thesis
           using assms vv' ww'
           by (intro coherent' [of v v' w w' t]) auto
       qed
       have 2: "t' \\ w' \<frown> u' \\ w'"
         using assms 1 ww'
         by (metis Cong\<^sub>0_subst_left(1) Cong\<^sub>0_subst_right(1) Resid_along_normal_preserves_reflects_con
             R.arr_resid_iff_con R.coinitial_iff R.con_imp_coinitial elements_are_arr)
       thus 3: "t' \<frown> u'"
         using ww' R.cube by force
       have "t \\ u \<approx> ((t \\ u) \\ (w \\ u)) \\ (?y' \\ ?y)"
       proof -
         have "t \\ u \<approx> (t \\ u) \\ (w \\ u)"
           by (metis Cong_closure_props(4) assms(3) R.con_imp_coinitial
               elements_are_arr forward_stable R.arr_resid_iff_con R.con_implies_arr(1)
               R.sources_resid ww')
         also have "... \<approx> ((t \\ u) \\ (w \\ u)) \\ (?y' \\ ?y)"
           by (metis Cong\<^sub>0_imp_con Cong_closure_props(4) Cong_imp_arr(2)
               R.arr_resid_iff_con calculation R.con_implies_arr(2) R.targets_resid_sym
               R.sources_resid ww')
         finally show ?thesis by simp
       qed
       also have "... \<approx> (((t \\ w) \\ ?y) \\ (?y' \\ ?y))"
         using ww'
         by (metis Cong_imp_arr(2) Cong_reflexive calculation R.cube)
       also have "... \<approx> (((t' \\ w') \\ ?y) \\ (?y' \\ ?y))"
         using 1 Cong\<^sub>0_subst_left(2) [of "t \\ w" "(t' \\ w')" ?y]
               Cong\<^sub>0_subst_left(2) [of "(t \\ w) \\ ?y" "(t' \\ w') \\ ?y" "?y' \\ ?y"]
         by (meson 2 Cong\<^sub>0_implies_Cong Cong\<^sub>0_subst_Con Cong_imp_arr(2)
                   R.arr_resid_iff_con calculation ww')
       also have "... \<approx> ((t' \\ w') \\ ?y') \\ (?y \\ ?y')"
         using 2 Cong\<^sub>0_implies_Cong Cong\<^sub>0_subst_right(2) ww' by presburger
       also have 4: "... \<approx> (t' \\ u') \\ (w' \\ u')"
          using 2 ww'
          by (metis Cong\<^sub>0_imp_con Cong_closure_props(4) Cong_symmetric R.cube R.sources_resid)
       also have "... \<approx> t' \\ u'"
          using ww' 3 4
          by (metis Cong_closure_props(4) Cong_imp_arr(2) Cong_symmetric R.con_imp_coinitial
                    R.con_implies_arr(2) forward_stable R.sources_resid R.arr_resid_iff_con)
       finally show "t \\ u \<approx> t' \\ u'" by simp
     qed
 
     lemma Cong_subst_con:
     assumes "R.sources t = R.sources u" and "R.sources t' = R.sources u'" and "t \<approx> t'" and "u \<approx> u'"
     shows "t \<frown> u \<longleftrightarrow> t' \<frown> u'"
       using assms by (meson Cong_subst(1) Cong_symmetric)
 
     lemma Cong\<^sub>0_composite_of_arr_normal:
     assumes "R.composite_of t u t'" and "u \<in> \<NN>"
     shows "t' \<approx>\<^sub>0 t"
       using assms backward_stable R.composite_of_def ide_closed by blast
 
     lemma Cong_composite_of_normal_arr:
     assumes "R.composite_of u t t'" and "u \<in> \<NN>"
     shows "t' \<approx> t"
       using assms
       by (meson Cong_closure_props(2-4) R.arr_composite_of ide_closed R.composite_of_def
                 R.sources_composite_of)
 
   end
 
   context normal_sub_rts
   begin
 
     text \<open>
       Coherence is not an arbitrary property: here we show that substitutivity of
       congruence in residuation is equivalent to the ``opposing spans'' form of coherence.
     \<close>
 
     lemma Cong_subst_iff_coherent':
     shows "(\<forall>t t' u u'. t \<approx> t' \<and> u \<approx> u' \<and> t \<frown> u \<and> R.sources t' = R.sources u'
                            \<longrightarrow> t' \<frown> u' \<and> t \\ u \<approx> t' \\ u')
            \<longleftrightarrow>
            (\<forall>t t' v v' w w'. v \<in> \<NN> \<and> v' \<in> \<NN> \<and> w \<in> \<NN> \<and> w' \<in> \<NN> \<and>
                              R.sources v = R.sources w \<and> R.sources v' = R.sources w' \<and>
                              R.targets w = R.targets w' \<and> t \\ v \<approx>\<^sub>0 t' \\ v'
                                 \<longrightarrow> t \\ w \<approx>\<^sub>0 t' \\ w')"
     proof
       assume 1: "\<forall>t t' u u'. t \<approx> t' \<and> u \<approx> u' \<and> t \<frown> u \<and> R.sources t' = R.sources u'
                            \<longrightarrow> t' \<frown> u' \<and> t \\ u \<approx> t' \\ u'"
       show "\<forall>t t' v v' w w'. v \<in> \<NN> \<and> v' \<in> \<NN> \<and> w \<in> \<NN> \<and> w' \<in> \<NN> \<and>
                              R.sources v = R.sources w \<and> R.sources v' = R.sources w' \<and>
                              R.targets w = R.targets w' \<and> t \\ v \<approx>\<^sub>0 t' \\ v'
                                 \<longrightarrow> t \\ w \<approx>\<^sub>0 t' \\ w'"
       proof (intro allI impI, elim conjE)
         fix t t' v v' w w'
         assume v: "v \<in> \<NN>" and v': "v' \<in> \<NN>" and w: "w \<in> \<NN>" and w': "w' \<in> \<NN>"
         and sources_vw: "R.sources v = R.sources w"
         and sources_v'w': "R.sources v' = R.sources w'"
         and targets_ww': "R.targets w = R.targets w'"
         and tt': "(t \\ v) \\ (t' \\ v') \<in> \<NN>" and t't: "(t' \\ v') \\ (t \\ v) \<in> \<NN>"
         show "t \\ w \<approx>\<^sub>0 t' \\ w'"
         proof -
           have 2: "\<And>t t' u u'. \<lbrakk>t \<approx> t'; u \<approx> u'; t \<frown> u; R.sources t' = R.sources u'\<rbrakk>
                                    \<Longrightarrow> t' \<frown> u' \<and> t \\ u \<approx> t' \\ u'"
             using 1 by blast
           have 3: "t \\ w \<approx> t \\ v \<and> t' \\ w' \<approx> t' \\ v'"
             by (metis tt' t't sources_vw sources_v'w' Cong\<^sub>0_subst_right(2) Cong_closure_props(4)
                       Cong_def R.arr_resid_iff_con Cong_closure_props(3) Cong_imp_arr(1)
                       normal_is_Cong_closed v w v' w')
           have "(t \\ w) \\ (t' \\ w') \<approx> (t \\ v) \\ (t' \\ v')"
             using 2 [of "t \\ w" "t \\ v" "t' \\ w'" "t' \\ v'"] 3
             by (metis tt' t't targets_ww' 1 Cong\<^sub>0_imp_con Cong_imp_arr(1) Cong_symmetric
                 R.arr_resid_iff_con R.sources_resid)
           moreover have "(t' \\ w') \\ (t \\ w) \<approx> (t' \\ v') \\ (t \\ v)"
             using 2 3
             by (metis tt' t't targets_ww' Cong\<^sub>0_imp_con Cong_symmetric
                 Cong_imp_arr(1) R.arr_resid_iff_con R.sources_resid)
           ultimately show ?thesis
             by (meson tt' t't normal_is_Cong_closed Cong_symmetric)
         qed
       qed
       next
       assume 1: "\<forall>t t' v v' w w'. v \<in> \<NN> \<and> v' \<in> \<NN> \<and> w \<in> \<NN> \<and> w' \<in> \<NN> \<and>
                              R.sources v = R.sources w \<and> R.sources v' = R.sources w' \<and>
                              R.targets w = R.targets w' \<and> t \\ v \<approx>\<^sub>0 t' \\ v'
                                 \<longrightarrow> t \\ w \<approx>\<^sub>0 t' \\ w'"
       show "\<forall>t t' u u'. t \<approx> t' \<and> u \<approx> u' \<and> t \<frown> u \<and> R.sources t' = R.sources u'
                            \<longrightarrow> t' \<frown> u' \<and> t \\ u \<approx> t' \\ u'"
       proof (intro allI impI, elim conjE, intro conjI)
         have *: "\<And>t t' v v' w w'. \<lbrakk>v \<in> \<NN>; v' \<in> \<NN>; w \<in> \<NN>; w' \<in> \<NN>;
                                    R.sources v = R.sources w; R.sources v' = R.sources w';
                                    R.targets v = R.targets v'; R.targets w = R.targets w';
                                    t \\ v \<approx>\<^sub>0 t' \\ v'\<rbrakk>
                                       \<Longrightarrow> t \\ w \<approx>\<^sub>0 t' \\ w'"
           using 1 by metis
         fix t t' u u'
         assume tt': "t \<approx> t'" and uu': "u \<approx> u'" and con: "t \<frown> u"
         and t'u': "R.sources t' = R.sources u'"
         obtain v v' where vv': "v \<in> \<NN> \<and> v' \<in> \<NN> \<and> t \\ v \<approx>\<^sub>0 t' \\ v'"
           using tt' by auto
         obtain w w' where ww': "w \<in> \<NN> \<and> w' \<in> \<NN> \<and> u \\ w \<approx>\<^sub>0 u' \\ w'"
           using uu' by auto
         let ?x = "t \\ v" and ?x' = "t' \\ v'"
         let ?y = "u \\ w" and ?y' = "u' \\ w'"
         have xx': "?x \<approx>\<^sub>0 ?x'"
           using tt' vv' by blast
         have yy': "?y \<approx>\<^sub>0 ?y'"
           using uu' ww' by blast
         have 1: "t \\ w \<approx>\<^sub>0 t' \\ w'"
         proof -
           have "R.sources v = R.sources w \<and> R.sources v' = R.sources w'"
           proof
             show "R.sources v' = R.sources w'"
               using Cong\<^sub>0_imp_con R.arr_resid_iff_con R.coinitial_iff R.con_imp_coinitial
                     t'u' vv' ww'
               by metis
             show "R.sources v = R.sources w"
               by (metis con elements_are_arr R.not_arr_null R.null_is_zero(2) R.conI
                   R.con_imp_common_source rts.sources_eqI R.rts_axioms vv' ww')
           qed
           moreover have "R.targets v = R.targets v' \<and> R.targets w = R.targets w'"
             by (metis Cong\<^sub>0_imp_coinitial Cong\<^sub>0_imp_con R.arr_resid_iff_con
                 R.con_implies_arr(2) R.sources_resid vv' ww')
           ultimately show ?thesis
             using vv' ww' xx'
             by (intro * [of v v' w w' t t']) auto
         qed
         have 2: "t' \\ w' \<frown> u' \\ w'"
           using 1 tt' ww'
           by (meson Cong\<^sub>0_imp_con Cong\<^sub>0_subst_Con R.arr_resid_iff_con con R.con_imp_coinitial
               R.con_implies_arr(2) resid_along_elem_preserves_con)
         thus 3: "t' \<frown> u'"
           using ww' R.cube by force
         have "t \\ u \<approx> (t \\ u) \\ (w \\ u)"
           by (metis Cong_closure_props(4) R.arr_resid_iff_con con R.con_imp_coinitial
               elements_are_arr forward_stable R.con_implies_arr(2) R.sources_resid ww')
         also have "(t \\ u) \\ (w \\ u) \<approx> ((t \\ u) \\ (w \\ u)) \\ (?y' \\ ?y)"
           using yy'
           by (metis Cong\<^sub>0_imp_con Cong_closure_props(4) Cong_imp_arr(2)
               R.arr_resid_iff_con calculation R.con_implies_arr(2) R.sources_resid R.targets_resid_sym)
         also have "... \<approx> (((t \\ w) \\ ?y) \\ (?y' \\ ?y))"
           using ww'
           by (metis Cong_imp_arr(2) Cong_reflexive calculation R.cube)
         also have "... \<approx> (((t' \\ w') \\ ?y) \\ (?y' \\ ?y))"
         proof -
           have "((t \\ w) \\ ?y) \\ (?y' \\ ?y) \<approx>\<^sub>0 ((t' \\ w') \\ ?y) \\ (?y' \\ ?y)"
             using 1 2 Cong\<^sub>0_subst_left(2)
             by (meson Cong\<^sub>0_subst_Con calculation Cong_imp_arr(2) R.arr_resid_iff_con ww')
           thus ?thesis
             using Cong\<^sub>0_implies_Cong by presburger
         qed
         also have "... \<approx> ((t' \\ w') \\ ?y') \\ (?y \\ ?y')"
           by (meson "2" Cong\<^sub>0_implies_Cong Cong\<^sub>0_subst_right(2) ww')
         also have 4: "... \<approx> (t' \\ u') \\ (w' \\ u')"
            using 2 ww'
            by (metis Cong\<^sub>0_imp_con Cong_closure_props(4) Cong_symmetric R.cube R.sources_resid)
         also have "... \<approx> t' \\ u'"
            using ww' 2 3 4
            by (metis Cong'.intros(1) Cong'.intros(4) Cong_char Cong_imp_arr(2)
                R.arr_resid_iff_con forward_stable R.con_imp_coinitial R.sources_resid
                R.con_implies_arr(2))
         finally show "t \\ u \<approx> t' \\ u'" by simp
       qed
     qed
 
   end
 
   subsection "Quotient by Coherent Normal Sub-RTS"
 
   text \<open>
     We now define the quotient of an RTS by a coherent normal sub-RTS and show that it is
     an extensional RTS.
   \<close>
 
   locale quotient_by_coherent_normal =
     R: rts +
     N: coherent_normal_sub_rts
   begin
 
     definition Resid  (infix "\<lbrace>\\\<rbrace>" 70)
     where "\<T> \<lbrace>\\\<rbrace> \<U> \<equiv>
            if N.is_Cong_class \<T> \<and> N.is_Cong_class \<U> \<and> (\<exists>t u. t \<in> \<T> \<and> u \<in> \<U> \<and> t \<frown> u)
            then N.Cong_class
                   (fst (SOME tu. fst tu \<in> \<T> \<and> snd tu \<in> \<U> \<and> fst tu \<frown> snd tu) \\
                    snd (SOME tu. fst tu \<in> \<T> \<and> snd tu \<in> \<U> \<and> fst tu \<frown> snd tu))
            else {}"
 
     sublocale partial_magma Resid
       using N.Cong_class_is_nonempty Resid_def
       by unfold_locales metis
 
     lemma is_partial_magma:
     shows "partial_magma Resid"
       ..
 
     lemma null_char:
     shows "null = {}"
       using N.Cong_class_is_nonempty Resid_def
       by (metis null_is_zero(2))
 
     lemma Resid_by_members:
     assumes "N.is_Cong_class \<T>" and "N.is_Cong_class \<U>" and "t \<in> \<T>" and "u \<in> \<U>" and "t \<frown> u"
     shows "\<T> \<lbrace>\\\<rbrace> \<U> = \<lbrace>t \\ u\<rbrace>"
       using assms Resid_def someI_ex [of "\<lambda>tu. fst tu \<in> \<T> \<and> snd tu \<in> \<U> \<and> fst tu \<frown> snd tu"]
       apply simp
       by (meson N.Cong_class_membs_are_Cong N.Cong_class_eqI N.Cong_subst(2)
           R.coinitial_iff R.con_imp_coinitial)
 
     abbreviation Con  (infix "\<lbrace>\<frown>\<rbrace>" 50)
     where "\<T> \<lbrace>\<frown>\<rbrace> \<U> \<equiv> \<T> \<lbrace>\\\<rbrace> \<U> \<noteq> {}"
 
     lemma Con_char:
     shows "\<T> \<lbrace>\<frown>\<rbrace> \<U> \<longleftrightarrow>
            N.is_Cong_class \<T> \<and> N.is_Cong_class \<U> \<and> (\<exists>t u. t \<in> \<T> \<and> u \<in> \<U> \<and> t \<frown> u)"
       by (metis (no_types, opaque_lifting) N.Cong_class_is_nonempty N.is_Cong_classI
           Resid_def Resid_by_members R.arr_resid_iff_con)
 
     lemma Con_sym:
     assumes "Con \<T> \<U>"
     shows "Con \<U> \<T>"
       using assms Con_char R.con_sym by meson
 
     lemma is_Cong_class_Resid:
     assumes "\<T> \<lbrace>\<frown>\<rbrace> \<U>"
     shows "N.is_Cong_class (\<T> \<lbrace>\\\<rbrace> \<U>)"
       using assms Con_char Resid_by_members R.arr_resid_iff_con N.is_Cong_classI by auto
 
     lemma Con_witnesses:
     assumes "\<T> \<lbrace>\<frown>\<rbrace> \<U>" and "t \<in> \<T>" and "u \<in> \<U>"
     shows "\<exists>v w. v \<in> \<NN> \<and> w \<in> \<NN> \<and> t \\ v \<frown> u \\ w"
     proof -
       have 1: "N.is_Cong_class \<T> \<and> N.is_Cong_class \<U> \<and> (\<exists>t u. t \<in> \<T> \<and> u \<in> \<U> \<and> t \<frown> u)"
         using assms Con_char by simp
       obtain t' u' where t'u': "t' \<in> \<T> \<and> u' \<in> \<U> \<and> t' \<frown> u'"
         using 1 by auto
       have 2: "t' \<approx> t \<and> u' \<approx> u"
         using assms 1 t'u' N.Cong_class_membs_are_Cong by auto
       obtain v v' where vv': "v \<in> \<NN> \<and> v' \<in> \<NN> \<and> t' \\ v \<approx>\<^sub>0 t \\ v'"
         using 2 by auto
       obtain w w' where ww': "w \<in> \<NN> \<and> w' \<in> \<NN> \<and> u' \\ w \<approx>\<^sub>0 u \\ w'"
         using 2 by auto
       have 3: "w \<frown> v"
         by (metis R.arr_resid_iff_con R.con_def R.con_imp_coinitial R.ex_un_null
             N.elements_are_arr R.null_is_zero(2) N.resid_along_elem_preserves_con t'u' vv' ww')
       have "R.seq v (w \\ v)"
         by (simp add: N.elements_are_arr R.seq_def 3 vv')
       obtain x where x: "R.composite_of v (w \\ v) x"
         using N.composite_closed_left \<open>R.seq v (w \ v)\<close> vv' by blast
       obtain x' where x': "R.composite_of v' (w \\ v) x'"
         using x vv' N.composite_closed_left
         by (metis N.Cong\<^sub>0_implies_Cong N.Cong\<^sub>0_imp_coinitial N.Cong_imp_arr(1)
             R.composable_def R.composable_imp_seq R.con_implies_arr(2)
             R.seq_def R.sources_resid R.arr_resid_iff_con)
       have *: "t' \\ x \<approx>\<^sub>0 t \\ x'"
         by (metis N.coherent' N.composite_closed N.forward_stable R.con_imp_coinitial
             R.targets_composite_of 3 R.con_sym R.sources_composite_of vv' ww' x x')
       obtain y where y: "R.composite_of w (v \\ w) y"
         using x vv' ww'
         by (metis R.arr_resid_iff_con R.composable_def R.composable_imp_seq
             R.con_imp_coinitial R.seq_def R.sources_resid N.elements_are_arr
             N.forward_stable N.composite_closed_left)
       obtain y' where y': "R.composite_of w' (v \\ w) y'"
         using y ww'
         by (metis N.Cong\<^sub>0_imp_coinitial N.Cong_closure_props(3) N.Cong_imp_arr(1)
             R.composable_def R.composable_imp_seq R.con_implies_arr(2) R.seq_def
             R.sources_resid N.composite_closed_left R.arr_resid_iff_con)
       have **: "u' \\ y \<approx>\<^sub>0 u \\ y'"
         by (metis N.composite_closed N.forward_stable R.con_imp_coinitial R.targets_composite_of
             \<open>w \<frown> v\<close> N.coherent' R.sources_composite_of vv' ww' y y')
       have 4: "x \<in> \<NN> \<and> y \<in> \<NN>"
         using x y vv' ww' * **
         by (metis 3 N.composite_closed N.forward_stable R.con_imp_coinitial R.con_sym)
       have "t \\ x' \<frown> u \\ y'"
       proof -
         have "t \\ x' \<approx>\<^sub>0 t' \\ x"
           using * by simp
         moreover have "t' \\ x \<frown> u' \\ y"
         proof -
           have "t' \\ x \<frown> u' \\ x"
             using t'u' vv' ww' 4 *
             by (metis N.Resid_along_normal_preserves_reflects_con N.elements_are_arr
                 R.coinitial_iff R.con_imp_coinitial R.arr_resid_iff_con)
           moreover have "u' \\ x \<approx>\<^sub>0 u' \\ y"
             using ww' x y
             by (metis 4 N.Cong\<^sub>0_imp_coinitial N.Cong\<^sub>0_imp_con N.Cong\<^sub>0_transitive
                 N.coherent' N.factor_closed(2) R.sources_composite_of
                 R.targets_composite_of R.targets_resid_sym)
           ultimately show ?thesis
             using N.Cong\<^sub>0_subst_right by blast
         qed
         moreover have "u' \\ y \<approx>\<^sub>0 u \\ y'"
           using ** R.con_sym by simp
         ultimately show ?thesis
           using N.Cong\<^sub>0_subst_Con by auto
       qed
       moreover have "x' \<in> \<NN> \<and> y' \<in> \<NN>"
         using x' y' vv' ww'
         by (metis N.Cong_composite_of_normal_arr N.Cong_imp_arr(2) N.composite_closed
             R.con_imp_coinitial N.forward_stable R.arr_resid_iff_con)
       ultimately show ?thesis by auto
     qed
 
     abbreviation Arr
     where "Arr \<T> \<equiv> Con \<T> \<T>"
 
     lemma Arr_Resid:
     assumes "Con \<T> \<U>"
     shows "Arr (\<T> \<lbrace>\\\<rbrace> \<U>)"
       by (metis Con_char N.Cong_class_memb_is_arr R.arrE N.rep_in_Cong_class
           assms is_Cong_class_Resid)
 
     lemma Cube:
     assumes "Con (\<V> \<lbrace>\\\<rbrace> \<T>) (\<U> \<lbrace>\\\<rbrace> \<T>)"
     shows "(\<V> \<lbrace>\\\<rbrace> \<T>) \<lbrace>\\\<rbrace> (\<U> \<lbrace>\\\<rbrace> \<T>) = (\<V> \<lbrace>\\\<rbrace> \<U>) \<lbrace>\\\<rbrace> (\<T> \<lbrace>\\\<rbrace> \<U>)"
     proof -
       obtain t u where tu: "t \<in> \<T> \<and> u \<in> \<U> \<and> t \<frown> u \<and> \<T> \<lbrace>\\\<rbrace> \<U> = \<lbrace>t \\ u\<rbrace>"
         using assms
         by (metis Con_char N.Cong_class_is_nonempty R.con_sym Resid_by_members)
       obtain t' v where t'v: "t' \<in> \<T> \<and> v \<in> \<V> \<and> t' \<frown> v \<and> \<T> \<lbrace>\\\<rbrace> \<V> = \<lbrace>t' \\ v\<rbrace>"
         using assms
         by (metis Con_char N.Cong_class_is_nonempty Resid_by_members Con_sym)
       have tt': "t \<approx> t'"
         using assms
         by (metis N.Cong_class_membs_are_Cong N.Cong_class_is_nonempty Resid_def t'v tu)
       obtain w w' where ww': "w \<in> \<NN> \<and> w' \<in> \<NN> \<and> t \\ w \<approx>\<^sub>0 t' \\ w'"
         using tu t'v tt' by auto
       have 1: "\<U> \<lbrace>\\\<rbrace> \<T> = \<lbrace>u \\ t\<rbrace> \<and> \<V> \<lbrace>\\\<rbrace> \<T> = \<lbrace>v \\ t'\<rbrace>"
         by (metis Con_char N.Cong_class_is_nonempty R.con_sym Resid_by_members assms t'v tu)
       obtain x x' where xx': "x \<in> \<NN> \<and> x' \<in> \<NN> \<and> (u \\ t) \\ x \<frown> (v \\ t') \\ x'"
         using 1 Con_witnesses [of "\<U> \<lbrace>\\\<rbrace> \<T>" "\<V> \<lbrace>\\\<rbrace> \<T>" "u \\ t" "v \\ t'"]
         by (metis N.arr_in_Cong_class R.con_sym t'v tu assms Con_sym R.arr_resid_iff_con)
       have "R.seq t x"
         by (metis R.arr_resid_iff_con R.coinitial_iff R.con_imp_coinitial R.seqI
             R.sources_resid xx')
       have "R.seq t' x'"
         by (metis R.arr_resid_iff_con R.sources_resid R.coinitialE R.con_imp_coinitial
             R.seqI xx')
       obtain tx where tx: "R.composite_of t x tx"
         using xx' \<open>R.seq t x\<close> N.composite_closed_right [of x t] R.composable_def by auto
       obtain t'x' where t'x': "R.composite_of t' x' t'x'"
         using xx' \<open>R.seq t' x'\<close> N.composite_closed_right [of x' t'] R.composable_def by auto
       let ?tx_w = "tx \\ w" and ?t'x'_w' = "t'x' \\ w'"
       let ?w_tx = "(w \\ t) \\ x" and ?w'_t'x' = "(w' \\ t') \\ x'"
       let ?u_tx = "(u \\ t) \\ x" and ?v_t'x' = "(v \\ t') \\ x'"
       let ?u_w = "u \\ w" and ?v_w' = "v \\ w'"
       let ?w_u = "w \\ u" and ?w'_v = "w' \\ v"
       have w_tx_in_\<NN>: "?w_tx \<in> \<NN>"
         using tx ww' xx' R.con_composite_of_iff [of t x tx w]
         by (metis (full_types) N.Cong\<^sub>0_composite_of_arr_normal N.Cong\<^sub>0_subst_left(1)
             N.forward_stable R.null_is_zero(2) R.con_imp_coinitial R.conI R.con_sym)
       have w'_t'x'_in_\<NN>: "?w'_t'x' \<in> \<NN>"
         using t'x' ww' xx' R.con_composite_of_iff [of t' x' t'x' w']
         by (metis (full_types) N.Cong\<^sub>0_composite_of_arr_normal N.Cong\<^sub>0_subst_left(1)
             R.con_sym N.forward_stable R.null_is_zero(2) R.con_imp_coinitial R.conI)
       have 2: "?tx_w \<approx>\<^sub>0 ?t'x'_w'"
       proof -
         have "?tx_w \<approx>\<^sub>0 t \\ w"
           using t'x' tx ww' xx' N.Cong\<^sub>0_composite_of_arr_normal [of t x tx] N.Cong\<^sub>0_subst_left(2)
           by (metis N.Cong\<^sub>0_transitive R.conI)
         also have "t \\ w \<approx>\<^sub>0 t' \\ w'"
           using ww' by blast
         also have "t' \\ w' \<approx>\<^sub>0 ?t'x'_w'"
           using t'x' tx ww' xx' N.Cong\<^sub>0_composite_of_arr_normal [of t' x' t'x'] N.Cong\<^sub>0_subst_left(2)
           by (metis N.Cong\<^sub>0_transitive R.conI)
         finally show ?thesis by blast
       qed
       obtain z where z: "R.composite_of ?tx_w (?t'x'_w' \\ ?tx_w) z"
         by (metis "2" R.arr_resid_iff_con R.con_implies_arr(2) N.elements_are_arr
             N.composite_closed_right R.seqI R.sources_resid)
       obtain z' where z': "R.composite_of ?t'x'_w' (?tx_w \\ ?t'x'_w') z'"
         by (metis "2" R.arr_resid_iff_con R.con_implies_arr(2) N.elements_are_arr
             N.composite_closed_right R.seqI R.sources_resid)
       have 3: "z \<approx>\<^sub>0 z'"
         using 2 N.diamond_commutes_upto_Cong\<^sub>0 N.Cong\<^sub>0_imp_con z z' by blast
       have "R.targets z = R.targets z'"
         by (metis R.targets_resid_sym z z' R.targets_composite_of R.conI)
       have Con_z_uw: "z \<frown> ?u_w"
       proof -
         have "?tx_w \<frown> ?u_w"
           by (meson 3 N.Cong\<^sub>0_composite_of_arr_normal N.Cong\<^sub>0_subst_left(1)
               R.bounded_imp_con R.con_implies_arr(1) R.con_imp_coinitial
               N.resid_along_elem_preserves_con tu tx ww' xx' z z' R.arr_resid_iff_con)
         thus ?thesis
           using 2 N.Cong\<^sub>0_composite_of_arr_normal N.Cong\<^sub>0_subst_left(1) z by blast
       qed
       moreover have Con_z'_vw': "z' \<frown> ?v_w'"
       proof -
         have "?t'x'_w' \<frown> ?v_w'"
           by (meson 3 N.Cong\<^sub>0_composite_of_arr_normal N.Cong\<^sub>0_subst_left(1)
               R.bounded_imp_con t'v t'x' ww' xx' z z' R.con_imp_coinitial
               N.resid_along_elem_preserves_con R.arr_resid_iff_con R.con_implies_arr(1))
         thus ?thesis
           by (meson 2 N.Cong\<^sub>0_composite_of_arr_normal N.Cong\<^sub>0_subst_left(1) z')
       qed
       moreover have Con_z_vw': "z \<frown> ?v_w'"
         using 3 Con_z'_vw' N.Cong\<^sub>0_subst_left(1) by blast
       moreover have *: "?u_w \\ z \<frown> ?v_w' \\ z"
       proof -
         obtain y where y: "R.composite_of (w \\ tx) (?t'x'_w' \\ ?tx_w) y"
           by (metis 2 R.arr_resid_iff_con R.composable_def R.composable_imp_seq
               R.con_imp_coinitial N.elements_are_arr N.composite_closed_right
               R.seq_def R.targets_resid_sym ww' z N.forward_stable)
         obtain y' where y': "R.composite_of (w' \\ t'x') (?tx_w \\ ?t'x'_w') y'"
           by (metis 2 R.arr_resid_iff_con R.composable_def R.composable_imp_seq
               R.con_imp_coinitial N.elements_are_arr N.composite_closed_right
               R.targets_resid_sym ww' z' R.seq_def N.forward_stable)
         have y_comp: "R.composite_of (w \\ tx) ((t'x' \\ w') \\ (tx \\ w)) y"
           using y by simp
         have y_in_normal: "y \<in> \<NN>"
           by (metis 2 Con_z_uw R.arr_iff_has_source R.arr_resid_iff_con N.composite_closed
               R.con_imp_coinitial R.con_implies_arr(1) N.forward_stable
               R.sources_composite_of ww' y_comp z)
         have y_coinitial: "R.coinitial y (u \\ tx)"
           using y R.coinitial_def
           by (metis Con_z_uw R.con_def R.con_prfx_composite_of(2) R.con_sym R.cube
               R.sources_composite_of R.con_imp_common_source z)
         have y_con: "y \<frown> u \\ tx"
           using y_in_normal y_coinitial
             by (metis R.coinitial_iff N.elements_are_arr N.forward_stable
                 R.arr_resid_iff_con)
         have A: "?u_w \\ z \<sim> (u \\ tx) \\ y"
         proof -
           have "(u \\ tx) \\ y \<sim> ((u \\ tx) \\ (w \\ tx)) \\ (?t'x'_w' \\ ?tx_w)"
             using y_comp y_con 
                   R.resid_composite_of(3) [of "w \\ tx" "?t'x'_w' \\ ?tx_w" y "u \\ tx"]
             by simp
           also have "((u \\ tx) \\ (w \\ tx)) \\ (?t'x'_w' \\ ?tx_w) \<sim> ?u_w \\ z"
             by (metis Con_z_uw R.resid_composite_of(3) z R.cube)
           finally show ?thesis by blast
         qed
         have y'_comp: "R.composite_of (w' \\ t'x') (?tx_w \\ ?t'x'_w') y'"
           using y' by simp
         have y'_in_normal: "y' \<in> \<NN>"
           by (metis 2 Con_z'_vw' R.arr_iff_has_source R.arr_resid_iff_con
               N.composite_closed R.con_imp_coinitial R.con_implies_arr(1)
               N.forward_stable R.sources_composite_of ww' y'_comp z')
         have y'_coinitial: "R.coinitial y' (v \\ t'x')"
           using y' R.coinitial_def
           by (metis Con_z'_vw' R.arr_resid_iff_con R.composite_ofE R.con_imp_coinitial
               R.con_implies_arr(1) R.cube R.prfx_implies_con R.resid_composite_of(1)
               R.sources_resid z')
         have y'_con: "y' \<frown> v \\ t'x'"
           using y'_in_normal y'_coinitial
           by (metis R.coinitial_iff N.elements_are_arr N.forward_stable
               R.arr_resid_iff_con)
         have B: "?v_w' \\ z' \<sim> (v \\ t'x') \\ y'"
         proof -
           have "(v \\ t'x') \\ y' \<sim> ((v \\ t'x') \\ (w' \\ t'x')) \\ (?tx_w \\ ?t'x'_w')"
             using y'_comp y'_con
                   R.resid_composite_of(3) [of "w' \\ t'x'" "?tx_w \\ ?t'x'_w'" y' "v \\ t'x'"]
             by blast
           also have "((v \\ t'x') \\ (w' \\ t'x')) \\ (?tx_w \\ ?t'x'_w') \<sim> ?v_w' \\ z'"
             by (metis Con_z'_vw' R.cube R.resid_composite_of(3) z')
           finally show ?thesis by blast
         qed
         have C: "u \\ tx \<frown> v \\ t'x'"
           using tx t'x' xx' R.con_sym R.cong_subst_right(1) R.resid_composite_of(3)
           by (meson R.coinitial_iff R.arr_resid_iff_con y'_coinitial y_coinitial)
         have D: "y \<approx>\<^sub>0 y'"
         proof -
           have "y \<approx>\<^sub>0 w \\ tx"
             using 2 N.Cong\<^sub>0_composite_of_arr_normal y_comp by blast
           also have "w \\ tx \<approx>\<^sub>0 w' \\ t'x'"
           proof -
             have "w \\ tx \<in> \<NN> \<and> w' \\ t'x' \<in> \<NN>"
               using N.factor_closed(1) y_comp y_in_normal y'_comp y'_in_normal by blast
             moreover have "R.coinitial (w \\ tx) (w' \\ t'x')"
               by (metis C R.coinitial_def R.con_implies_arr(2) N.elements_are_arr
                   R.sources_resid calculation R.con_imp_coinitial R.arr_resid_iff_con y_con)
             ultimately show ?thesis
               by (meson R.arr_resid_iff_con R.con_imp_coinitial N.forward_stable
                   N.elements_are_arr)
           qed
           also have "w' \\ t'x' \<approx>\<^sub>0 y'"
             using 2 N.Cong\<^sub>0_composite_of_arr_normal y'_comp by blast
           finally show ?thesis by blast
         qed
         have par_y_y': "R.sources y = R.sources y' \<and> R.targets y = R.targets y'"
           using D N.Cong\<^sub>0_imp_coinitial R.targets_composite_of y'_comp y_comp z z'
                 \<open>R.targets z = R.targets z'\<close>
           by presburger
         have E: "(u \\ tx) \\ y \<frown> (v \\ t'x') \\ y'"
         proof -
           have "(u \\ tx) \\ y \<frown> (v \\ t'x') \\ y"
             using C N.Resid_along_normal_preserves_reflects_con R.coinitial_iff
                   y_coinitial y_in_normal
             by presburger
           moreover have "(v \\ t'x') \\ y \<approx>\<^sub>0 (v \\ t'x') \\ y'"
             using par_y_y' N.coherent R.coinitial_iff y'_coinitial y'_in_normal y_in_normal
             by presburger
           ultimately show ?thesis
             using N.Cong\<^sub>0_subst_right(1) by blast
         qed
         hence "?u_w \\ z \<frown> ?v_w' \\ z'"
         proof -
           have "(u \\ tx) \\ y \<sim> ?u_w \\ z"
             using A by simp
           moreover have "(u \\ tx) \\ y \<frown> (v \\ t'x') \\ y'"
             using E by blast
           moreover have "(v \\ t'x') \\ y' \<sim> ?v_w' \\ z'"
             using B R.cong_symmetric by blast
           moreover have "R.sources ((u \\ w) \\ z) = R.sources ((v \\ w') \\ z')"
             by (simp add: Con_z'_vw' Con_z_uw R.con_sym \<open>R.targets z = R.targets z'\<close>)
           ultimately show ?thesis
             by (meson N.Cong\<^sub>0_subst_Con N.ide_closed)
         qed
         moreover have "?v_w' \\ z' \<approx> ?v_w' \\ z"
           by (meson 3 Con_z_vw' N.CongI N.Cong\<^sub>0_subst_right(2) R.con_sym)
         moreover have "R.sources ((v \\ w') \\ z) = R.sources ((u \\ w) \\ z)"
           by (metis R.con_implies_arr(1) R.sources_resid calculation(1) calculation(2)
                     N.Cong_imp_arr(2) R.arr_resid_iff_con)
         ultimately show ?thesis
           by (metis N.Cong_reflexive N.Cong_subst(1) R.con_implies_arr(1))
       qed
       ultimately have **: "?v_w' \\ z \<frown> ?u_w \\ z \<and>
                            (?v_w' \\ z) \\ (?u_w \\ z) = (?v_w' \\ ?u_w) \\ (z \\ ?u_w)"
         by (meson R.con_sym R.cube)
       have Cong_t_z: "t \<approx> z"
         by (metis 2 N.Cong\<^sub>0_composite_of_arr_normal N.Cong_closure_props(2-3)
             N.Cong_closure_props(4) N.Cong_imp_arr(2) R.coinitial_iff R.con_imp_coinitial
             tx ww' xx' z R.arr_resid_iff_con)
       have Cong_u_uw: "u \<approx> ?u_w"
         by (meson Con_z_uw N.Cong_closure_props(4) R.coinitial_iff R.con_imp_coinitial
             ww' R.arr_resid_iff_con)
       have Cong_v_vw': "v \<approx> ?v_w'"
         by (meson Con_z_vw' N.Cong_closure_props(4) R.coinitial_iff ww' R.con_imp_coinitial
             R.arr_resid_iff_con)
       have \<T>: "N.is_Cong_class \<T> \<and> z \<in> \<T>"
         by (metis (no_types, lifting) Cong_t_z N.Cong_class_eqI N.Cong_class_is_nonempty
             N.Cong_class_memb_Cong_rep N.Cong_class_rep N.Cong_imp_arr(2) N.arr_in_Cong_class
             tu assms Con_char)
       have \<U>: "N.is_Cong_class \<U> \<and> ?u_w \<in> \<U>"
         by (metis Con_char Con_z_uw Cong_u_uw Int_iff N.Cong_class_eqI' N.Cong_class_eqI
             N.arr_in_Cong_class R.con_implies_arr(2) N.is_Cong_classI tu assms empty_iff)
       have \<V>: "N.is_Cong_class \<V> \<and> ?v_w' \<in> \<V>"
         by (metis Con_char Con_z_vw' Cong_v_vw' Int_iff N.Cong_class_eqI' N.Cong_class_eqI
             N.arr_in_Cong_class R.con_implies_arr(2) N.is_Cong_classI t'v assms empty_iff)
       show "(\<V> \<lbrace>\\\<rbrace> \<T>) \<lbrace>\\\<rbrace> (\<U> \<lbrace>\\\<rbrace> \<T>) = (\<V> \<lbrace>\\\<rbrace> \<U>) \<lbrace>\\\<rbrace> (\<T> \<lbrace>\\\<rbrace> \<U>)"
       proof -
         have "(\<V> \<lbrace>\\\<rbrace> \<T>) \<lbrace>\\\<rbrace> (\<U> \<lbrace>\\\<rbrace> \<T>) = \<lbrace>(?v_w' \\ z) \\ (?u_w \\ z)\<rbrace>"
           using \<T> \<U> \<V> * Resid_by_members
           by (metis ** Con_char N.arr_in_Cong_class R.arr_resid_iff_con assms R.con_implies_arr(2))
         moreover have "(\<V> \<lbrace>\\\<rbrace> \<U>) \<lbrace>\\\<rbrace> (\<T> \<lbrace>\\\<rbrace> \<U>) = \<lbrace>(?v_w' \\ ?u_w) \\ (z \\ ?u_w)\<rbrace>"
           using Resid_by_members [of \<V> \<U> ?v_w' ?u_w] Resid_by_members [of \<T> \<U> z ?u_w]
                 Resid_by_members [of "\<V> \<lbrace>\\\<rbrace> \<U>" "\<T> \<lbrace>\\\<rbrace> \<U>" "?v_w' \\ ?u_w" "z \\ ?u_w"]
           by (metis \<T> \<U> \<V> * ** N.arr_in_Cong_class R.con_implies_arr(2) N.is_Cong_classI
               R.resid_reflects_con R.arr_resid_iff_con)
         ultimately show ?thesis
           using ** by simp
       qed
     qed
 
     sublocale residuation Resid
       using null_char Con_sym Arr_Resid Cube
       by unfold_locales metis+
 
     lemma is_residuation:
     shows "residuation Resid"
       ..
 
     lemma arr_char:
     shows "arr \<T> \<longleftrightarrow> N.is_Cong_class \<T>"
       by (metis N.is_Cong_class_def arrI not_arr_null null_char N.Cong_class_memb_is_arr
           Con_char R.arrE arrE arr_resid conI)
 
     lemma ide_char:
     shows "ide \<U> \<longleftrightarrow> arr \<U> \<and> \<U> \<inter> \<NN> \<noteq> {}"
     proof
       show "ide \<U> \<Longrightarrow> arr \<U> \<and> \<U> \<inter> \<NN> \<noteq> {}"
         apply (elim ideE)
         by (metis Con_char N.Cong\<^sub>0_reflexive Resid_by_members disjoint_iff null_char
             N.arr_in_Cong_class R.arrE R.arr_resid arr_resid conE)
       show "arr \<U> \<and> \<U> \<inter> \<NN> \<noteq> {} \<Longrightarrow> ide \<U>"
       proof -
         assume \<U>: "arr \<U> \<and> \<U> \<inter> \<NN> \<noteq> {}"
         obtain u where u: "R.arr u \<and> u \<in> \<U> \<inter> \<NN>"
           using \<U> arr_char
           by (metis IntI N.Cong_class_memb_is_arr disjoint_iff)
         show ?thesis
           by (metis IntD1 IntD2 N.Cong_class_eqI N.Cong_closure_props(4) N.arr_in_Cong_class
               N.is_Cong_classI Resid_by_members \<U> arrE arr_char disjoint_iff ideI
               N.Cong_class_eqI' R.arrE u)
       qed
     qed
 
     lemma ide_char':
     shows "ide \<A> \<longleftrightarrow> arr \<A> \<and> \<A> \<subseteq> \<NN>"
       by (metis Int_absorb2 Int_emptyI N.Cong_class_memb_Cong_rep N.Cong_closure_props(1)
           ide_char not_arr_null null_char N.normal_is_Cong_closed arr_char subsetI)
 
     lemma con_char\<^sub>Q\<^sub>C\<^sub>N:
     shows "con \<T> \<U> \<longleftrightarrow>
            N.is_Cong_class \<T> \<and> N.is_Cong_class \<U> \<and> (\<exists>t u. t \<in> \<T> \<and> u \<in> \<U> \<and> t \<frown> u)"
       by (metis Con_char conE conI null_char)
 
     (*
      * TODO: Does the stronger form of con_char hold in this context?
      * I am currently only able to prove it for the more special context of paths,
      * but it doesn't seem like that should be required.
      *
      * The issue is that congruent paths have the same sets of sources,
      * but this does not necessarily hold in general.  If we know that all representatives
      * of a congruence class have the same sets of sources, then we known that if any
      * pair of representatives is consistent, then the arbitrarily chosen representatives
      * of the congruence class are consistent.  This is by substitutivity of congruence,
      * which has coinitiality as a hypothesis.
      *
      * In the general case, we have to reason as follows: if t and u are consistent
      * representatives of \<T> and \<U>, and if t' and u' are arbitrary coinitial representatives
      * of \<T> and \<U>, then we can obtain "opposing spans" connecting t u and t' u'.
      * The opposing span form of coherence then implies that t' and u' are consistent.
      * So we should be able to show that if congruence classes \<T> and \<U> are consistent,
      * then all pairs of coinitial representatives are consistent.
      *)
 
     lemma con_imp_coinitial_members_are_con:
     assumes "con \<T> \<U>" and "t \<in> \<T>" and "u \<in> \<U>" and "R.sources t = R.sources u"
     shows "t \<frown> u"
       by (meson assms N.Cong_subst(1) N.is_Cong_classE con_char\<^sub>Q\<^sub>C\<^sub>N)
 
     sublocale rts Resid
     proof
       show 1: "\<And>\<A> \<T>. \<lbrakk>ide \<A>; con \<T> \<A>\<rbrakk> \<Longrightarrow> \<T> \<lbrace>\\\<rbrace> \<A> = \<T>"
       proof -
         fix \<A> \<T>
         assume \<A>: "ide \<A>" and con: "con \<T> \<A>"
         obtain t a where ta: "t \<in> \<T> \<and> a \<in> \<A> \<and> R.con t a \<and> \<T> \<lbrace>\\\<rbrace> \<A> = \<lbrace>t \\ a\<rbrace>"
           using con con_char\<^sub>Q\<^sub>C\<^sub>N Resid_by_members by auto
         have "a \<in> \<NN>"
           using \<A> ta ide_char' by auto
         hence "t \\ a \<approx> t"
           by (meson N.Cong_closure_props(4) N.Cong_symmetric R.coinitialE R.con_imp_coinitial
               ta)
         thus "\<T> \<lbrace>\\\<rbrace> \<A> = \<T>"
           using ta
           by (metis N.Cong_class_eqI N.Cong_class_memb_Cong_rep N.Cong_class_rep con con_char\<^sub>Q\<^sub>C\<^sub>N)
       qed
       show "\<And>\<T>. arr \<T> \<Longrightarrow> ide (trg \<T>)"
         by (metis N.Cong\<^sub>0_reflexive Resid_by_members disjoint_iff ide_char N.Cong_class_memb_is_arr
             N.arr_in_Cong_class N.is_Cong_class_def arr_char R.arrE R.arr_resid resid_arr_self)
       show "\<And>\<A> \<T>. \<lbrakk>ide \<A>; con \<A> \<T>\<rbrakk> \<Longrightarrow> ide (\<A> \<lbrace>\\\<rbrace> \<T>)"
         by (metis 1 arrE arr_resid con_sym ideE ideI cube)
       show "\<And>\<T> \<U>. con \<T> \<U> \<Longrightarrow> \<exists>\<A>. ide \<A> \<and> con \<A> \<T> \<and> con \<A> \<U>"
       proof -
         fix \<T> \<U>
         assume \<T>\<U>: "con \<T> \<U>"
         obtain t u where tu: "\<T> = \<lbrace>t\<rbrace> \<and> \<U> = \<lbrace>u\<rbrace> \<and> t \<frown> u"
           using \<T>\<U> con_char\<^sub>Q\<^sub>C\<^sub>N arr_char
           by (metis N.Cong_class_memb_Cong_rep N.Cong_class_eqI N.Cong_class_rep)
         obtain a where a: "a \<in> R.sources t"
           using \<T>\<U> tu R.con_implies_arr(1) R.arr_iff_has_source by blast
         have "ide \<lbrace>a\<rbrace> \<and> con \<lbrace>a\<rbrace> \<T> \<and> con \<lbrace>a\<rbrace> \<U>"
         proof (intro conjI)
           have 2: "a \<in> \<NN>"
             using \<T>\<U> tu a arr_char N.ide_closed R.sources_def by force
           show 3: "ide \<lbrace>a\<rbrace>"
             using \<T>\<U> tu 2 a ide_char arr_char con_char\<^sub>Q\<^sub>C\<^sub>N
             by (metis IntI N.arr_in_Cong_class N.is_Cong_classI empty_iff N.elements_are_arr)
           show "con \<lbrace>a\<rbrace> \<T>"
             using \<T>\<U> tu 2 3 a ide_char arr_char con_char\<^sub>Q\<^sub>C\<^sub>N
             by (metis N.arr_in_Cong_class R.composite_of_source_arr
                 R.composite_of_def R.prfx_implies_con R.con_implies_arr(1))
           show "con \<lbrace>a\<rbrace> \<U>"
             using \<T>\<U> tu a ide_char arr_char con_char\<^sub>Q\<^sub>C\<^sub>N
             by (metis N.arr_in_Cong_class R.composite_of_source_arr R.con_prfx_composite_of
                 N.is_Cong_classI R.con_implies_arr(1) R.con_implies_arr(2))
         qed
         thus "\<exists>\<A>. ide \<A> \<and> con \<A> \<T> \<and> con \<A> \<U>" by auto
       qed
       show "\<And>\<T> \<U> \<V>. \<lbrakk>ide (\<T> \<lbrace>\\\<rbrace> \<U>); con \<U> \<V>\<rbrakk> \<Longrightarrow> con (\<T> \<lbrace>\\\<rbrace> \<U>) (\<V> \<lbrace>\\\<rbrace> \<U>)"
       proof -
         fix \<T> \<U> \<V>
         assume \<T>\<U>: "ide (\<T> \<lbrace>\\\<rbrace> \<U>)"
         assume \<U>\<V>: "con \<U> \<V>"
         obtain t u where tu: "t \<in> \<T> \<and> u \<in> \<U> \<and> t \<frown> u \<and> \<T> \<lbrace>\\\<rbrace> \<U> = \<lbrace>t \\ u\<rbrace>"
           using \<T>\<U>
           by (meson Resid_by_members ide_implies_arr quotient_by_coherent_normal.con_char\<^sub>Q\<^sub>C\<^sub>N
               quotient_by_coherent_normal_axioms arr_resid_iff_con)
         obtain v u' where vu': "v \<in> \<V> \<and> u' \<in> \<U> \<and> v \<frown> u' \<and> \<V> \<lbrace>\\\<rbrace> \<U> = \<lbrace>v \\ u'\<rbrace>"
           by (meson R.con_sym Resid_by_members \<U>\<V> con_char\<^sub>Q\<^sub>C\<^sub>N)
         have 1: "u \<approx> u'"
           using \<U>\<V> tu vu'
           by (meson N.Cong_class_membs_are_Cong con_char\<^sub>Q\<^sub>C\<^sub>N)
         obtain w w' where ww': "w \<in> \<NN> \<and> w' \<in> \<NN> \<and> u \\ w \<approx>\<^sub>0 u' \\ w'"
           using 1 by auto
         have 2: "((t \\ u) \\ (w \\ u)) \\ ((u' \\ w') \\ (u \\ w)) \<frown>
                  ((v \\ u') \\ (w' \\ u')) \\ ((u \\ w) \\ (u' \\ w'))"
         proof -
           have "((t \\ u) \\ (w \\ u)) \\ ((u' \\ w') \\ (u \\ w)) \<in> \<NN>"
           proof -
             have "t \\ u \<in> \<NN>"
               using tu N.arr_in_Cong_class R.arr_resid_iff_con \<T>\<U> ide_char' by blast
             hence "(t \\ u) \\ (w \\ u) \<in> \<NN>"
               by (metis N.Cong_closure_props(4) N.forward_stable R.null_is_zero(2)
                   R.con_imp_coinitial R.sources_resid N.Cong_imp_arr(2) R.arr_resid_iff_con
                   tu ww' R.conI)
             thus ?thesis
               by (metis N.Cong_closure_props(4) N.normal_is_Cong_closed R.sources_resid
                   R.targets_resid_sym N.elements_are_arr R.arr_resid_iff_con ww' R.conI)
           qed
           moreover have "R.sources (((t \\ u) \\ (w \\ u)) \\ ((u' \\ w') \\ (u \\ w))) =
                          R.sources (((v \\ u') \\ (w' \\ u')) \\ ((u \\ w) \\ (u' \\ w')))"
           proof -
             have "R.sources (((t \\ u) \\ (w \\ u)) \\ ((u' \\ w') \\ (u \\ w))) =
                   R.targets ((u' \\ w') \\ (u \\ w))"
               using R.arr_resid_iff_con N.elements_are_arr R.sources_resid calculation by blast
             also have "... = R.targets ((u \\ w) \\ (u' \\ w'))"
               by (metis R.targets_resid_sym R.conI)
             also have "... = R.sources (((v \\ u') \\ (w' \\ u')) \\ ((u \\ w) \\ (u' \\ w')))"
               using R.arr_resid_iff_con N.elements_are_arr R.sources_resid
               by (metis N.Cong_closure_props(4) N.Cong_imp_arr(2) R.con_implies_arr(1)
                   R.con_imp_coinitial N.forward_stable R.targets_resid_sym vu' ww')
             finally show ?thesis by simp
           qed
           ultimately show ?thesis
             by (metis (no_types, lifting) N.Cong\<^sub>0_imp_con N.Cong_closure_props(4)
                 N.Cong_imp_arr(2) R.arr_resid_iff_con R.con_imp_coinitial N.forward_stable
                 R.null_is_zero(2) R.conI)
         qed
         moreover have "t \\ u \<approx> ((t \\ u) \\ (w \\ u)) \\ ((u' \\ w') \\ (u \\ w))"
           by (metis (no_types, opaque_lifting) N.Cong_closure_props(4) N.Cong_transitive
               N.forward_stable R.arr_resid_iff_con R.con_imp_coinitial R.rts_axioms calculation
               rts.coinitial_iff ww')
         moreover have "v \\ u' \<approx> ((v \\ u') \\ (w' \\ u')) \\ ((u \\ w) \\ (u' \\ w'))"
         proof -
           have "w' \\ u' \<in> \<NN>"
             by (meson R.con_implies_arr(2) R.con_imp_coinitial N.forward_stable
                 ww' N.Cong\<^sub>0_imp_con R.arr_resid_iff_con)
           moreover have "(u \\ w) \\ (u' \\ w') \<in> \<NN>"
             using ww' by blast
           ultimately show ?thesis
             by (meson 2 N.Cong_closure_props(2) N.Cong_closure_props(4) R.arr_resid_iff_con
                 R.coinitial_iff R.con_imp_coinitial)
         qed
         ultimately show "con (\<T> \<lbrace>\\\<rbrace> \<U>) (\<V> \<lbrace>\\\<rbrace> \<U>)"
           using con_char\<^sub>Q\<^sub>C\<^sub>N N.Cong_class_def N.is_Cong_classI tu vu' R.arr_resid_iff_con
           by auto
       qed
     qed
 
     lemma is_rts:
     shows "rts Resid"
       ..
 
     sublocale extensional_rts Resid
     proof
       fix \<T> \<U>
       assume \<T>\<U>: "cong \<T> \<U>"
       show "\<T> = \<U>"
       proof -
         obtain t u where tu: "\<T> = \<lbrace>t\<rbrace> \<and> \<U> = \<lbrace>u\<rbrace> \<and> t \<frown> u"
           by (metis Con_char N.Cong_class_eqI N.Cong_class_memb_Cong_rep N.Cong_class_rep
               \<T>\<U> ide_char not_arr_null null_char)
         have "t \<approx>\<^sub>0 u"
         proof
           show "t \\ u \<in> \<NN>"
             using tu \<T>\<U> Resid_by_members [of \<T> \<U> t u]
             by (metis (full_types) N.arr_in_Cong_class R.con_implies_arr(1-2)
                 N.is_Cong_classI ide_char' R.arr_resid_iff_con subset_iff)
           show "u \\ t \<in> \<NN>"
             using tu \<T>\<U> Resid_by_members [of \<U> \<T> u t] R.con_sym
             by (metis (full_types) N.arr_in_Cong_class R.con_implies_arr(1-2)
                 N.is_Cong_classI ide_char' R.arr_resid_iff_con subset_iff)
         qed
         hence "t \<approx> u"
           using N.Cong\<^sub>0_implies_Cong by simp
         thus "\<T> = \<U>"
           by (simp add: N.Cong_class_eqI tu)
       qed
     qed
 
     theorem is_extensional_rts:
     shows "extensional_rts Resid"
       ..
 
     lemma sources_char\<^sub>Q\<^sub>C\<^sub>N:
     shows "sources \<T> = {\<A>. arr \<T> \<and> \<A> = {a. \<exists>t a'. t \<in> \<T> \<and> a' \<in> R.sources t \<and> a' \<approx> a}}"
     proof -
       let ?\<A> = "{a. \<exists>t a'. t \<in> \<T> \<and> a' \<in> R.sources t \<and> a' \<approx> a}"
       have 1: "arr \<T> \<Longrightarrow> ide ?\<A>"
       proof (unfold ide_char', intro conjI)
         assume \<T>: "arr \<T>"
         show "?\<A> \<subseteq> \<NN>"
           using N.ide_closed N.normal_is_Cong_closed by blast
         show "arr ?\<A>"
         proof -
           have "N.is_Cong_class ?\<A>"
           proof
             show "?\<A> \<noteq> {}"
               by (metis (mono_tags, lifting) Collect_empty_eq N.Cong_class_def N.Cong_imp_arr(1)
                   N.is_Cong_class_def N.sources_are_Cong R.arr_iff_has_source R.sources_def
                   \<T> arr_char mem_Collect_eq)
             show "\<And>t t'. \<lbrakk>t \<in> ?\<A>; t' \<approx> t\<rbrakk> \<Longrightarrow> t' \<in> ?\<A>"
               using N.Cong_symmetric N.Cong_transitive by blast
             show "\<And>a a'. \<lbrakk>a \<in> ?\<A>; a' \<in> ?\<A>\<rbrakk> \<Longrightarrow> a \<approx> a'"
             proof -
               fix a a'
               assume a: "a \<in> ?\<A>" and a': "a' \<in> ?\<A>"
               obtain t b where b: "t \<in> \<T> \<and> b \<in> R.sources t \<and> b \<approx> a"
                 using a by blast
               obtain t' b' where b': "t' \<in> \<T> \<and> b' \<in> R.sources t' \<and> b' \<approx> a'"
                 using a' by blast
               have "b \<approx> b'"
                 using \<T> arr_char b b'
                 by (meson IntD1 N.Cong_class_membs_are_Cong N.in_sources_respects_Cong)
               thus "a \<approx> a'"
                 by (meson N.Cong_symmetric N.Cong_transitive b b')
             qed
           qed
           thus ?thesis
             using arr_char by auto
         qed
       qed
       moreover have "arr \<T> \<Longrightarrow> con \<T> ?\<A>"
       proof -
         assume \<T>: "arr \<T>"
         obtain t a where a: "t \<in> \<T> \<and> a \<in> R.sources t"
           using \<T> arr_char
           by (metis N.Cong_class_is_nonempty R.arr_iff_has_source empty_subsetI
                     N.Cong_class_memb_is_arr subsetI subset_antisym)
         have "t \<in> \<T> \<and> a \<in> {a. \<exists>t a'. t \<in> \<T> \<and> a' \<in> R.sources t \<and> a' \<approx> a} \<and> t \<frown> a"
           using a N.Cong_reflexive R.sources_def R.con_implies_arr(2) by fast
         thus ?thesis
           using \<T> 1 arr_char con_char\<^sub>Q\<^sub>C\<^sub>N [of \<T> ?\<A>] by auto
       qed
       ultimately have "arr \<T> \<Longrightarrow> ?\<A> \<in> sources \<T>"
         using sources_def by blast
       thus ?thesis
         using "1" ide_char sources_char by auto
     qed
 
     lemma targets_char\<^sub>Q\<^sub>C\<^sub>N:
     shows "targets \<T> = {\<B>. arr \<T> \<and> \<B> = \<T> \<lbrace>\\\<rbrace> \<T>}"
     proof -
       have "targets \<T> = {\<B>. ide \<B> \<and> con (\<T> \<lbrace>\\\<rbrace> \<T>) \<B>}"
         by (simp add: targets_def trg_def)
       also have "... = {\<B>. arr \<T> \<and> ide \<B> \<and> (\<exists>t u. t \<in> \<T> \<lbrace>\\\<rbrace> \<T> \<and> u \<in> \<B> \<and> t \<frown> u)}"
         using arr_resid_iff_con con_char\<^sub>Q\<^sub>C\<^sub>N arr_char arr_def by auto
       also have "... = {\<B>. arr \<T> \<and> ide \<B> \<and>
                            (\<exists>t t' b u. t \<in> \<T> \<and> t' \<in> \<T> \<and> t \<frown> t' \<and> b \<in> \<lbrace>t \\ t'\<rbrace> \<and> u \<in> \<B> \<and> b \<frown> u)}"
         using arr_char ide_char Resid_by_members [of \<T> \<T>] N.Cong_class_memb_is_arr
               N.is_Cong_class_def R.arr_def
         by auto metis+
       also have "... = {\<B>. arr \<T> \<and> ide \<B> \<and>
                            (\<exists>t t' b. t \<in> \<T> \<and> t' \<in> \<T> \<and> t \<frown> t' \<and> b \<in> \<lbrace>t \\ t'\<rbrace> \<and> b \<in> \<B>)}"
       proof -
         have "\<And>\<B> t t' b. \<lbrakk>arr \<T>; ide \<B>; t \<in> \<T>; t' \<in> \<T>; t \<frown> t'; b \<in> \<lbrace>t \\ t'\<rbrace>\<rbrakk>
                             \<Longrightarrow> (\<exists>u. u \<in> \<B> \<and> b \<frown> u) \<longleftrightarrow> b \<in> \<B>"
         proof -
           fix \<B> t t' b
           assume \<T>: "arr \<T>" and \<B>: "ide \<B>" and t: "t \<in> \<T>" and t': "t' \<in> \<T>"
                  and tt': "t \<frown> t'" and b: "b \<in> \<lbrace>t \\ t'\<rbrace>"
           have 0: "b \<in> \<NN>"
             by (metis Resid_by_members \<T> b ide_char' ide_trg arr_char subsetD t t' trg_def tt')
           show "(\<exists>u. u \<in> \<B> \<and> b \<frown> u) \<longleftrightarrow> b \<in> \<B>"
             using 0
             by (meson N.Cong_closure_props(3) N.forward_stable N.elements_are_arr
                 \<B> arr_char R.con_imp_coinitial N.is_Cong_classE ide_char' R.arrE
                 R.con_sym subsetD)
         qed
         thus ?thesis
           using ide_char arr_char
           by (metis (no_types, lifting))
       qed
       also have "... = {\<B>. arr \<T> \<and> ide \<B> \<and> (\<exists>t t'. t \<in> \<T> \<and> t' \<in> \<T> \<and> t \<frown> t' \<and> \<lbrace>t \\ t'\<rbrace> \<subseteq> \<B>)}"
       proof -
         have "\<And>\<B> t t' b. \<lbrakk>arr \<T>; ide \<B>; t \<in> \<T>; t' \<in> \<T>; t \<frown> t'\<rbrakk>
                             \<Longrightarrow> (\<exists>b. b \<in> \<lbrace>t \\ t'\<rbrace> \<and> b \<in> \<B>) \<longleftrightarrow> \<lbrace>t \\ t'\<rbrace> \<subseteq> \<B>"
           using ide_char arr_char
           apply (intro iffI)
            apply (metis IntI N.Cong_class_eqI' R.arr_resid_iff_con N.is_Cong_classI empty_iff
                         set_eq_subset)
           by (meson N.arr_in_Cong_class R.arr_resid_iff_con subsetD)
         thus ?thesis
           using ide_char arr_char
           by (metis (no_types, lifting))
       qed
       also have "... = {\<B>. arr \<T> \<and> ide \<B> \<and> \<T> \<lbrace>\\\<rbrace> \<T> \<subseteq> \<B>}"
         using arr_char ide_char Resid_by_members [of \<T> \<T>]
         by (metis (no_types, opaque_lifting) arrE con_char\<^sub>Q\<^sub>C\<^sub>N)
       also have "... = {\<B>. arr \<T> \<and> \<B> = \<T> \<lbrace>\\\<rbrace> \<T>}"
         by (metis (no_types, lifting) arr_has_un_target calculation con_ide_are_eq
             cong_reflexive mem_Collect_eq targets_def trg_def)
       finally show ?thesis by blast
     qed
 
     lemma src_char\<^sub>Q\<^sub>C\<^sub>N:
     shows "src \<T> = {a. arr \<T> \<and> (\<exists>t a'. t \<in> \<T> \<and> a' \<in> R.sources t \<and> a' \<approx> a)}"
       using sources_char\<^sub>Q\<^sub>C\<^sub>N [of \<T>]
       by (simp add: null_char src_def)
 
     lemma trg_char\<^sub>Q\<^sub>C\<^sub>N:
     shows "trg \<T> = \<T> \<lbrace>\\\<rbrace> \<T>"
       unfolding trg_def by blast
 
     subsubsection "Quotient Map"
 
     abbreviation quot
     where "quot t \<equiv> \<lbrace>t\<rbrace>"
 
     sublocale quot: simulation resid Resid quot
     proof
       show "\<And>t. \<not> R.arr t \<Longrightarrow> \<lbrace>t\<rbrace> = null"
         using N.Cong_class_def N.Cong_imp_arr(1) null_char by force
       show "\<And>t u. t \<frown> u \<Longrightarrow> con \<lbrace>t\<rbrace> \<lbrace>u\<rbrace>"
         by (meson N.arr_in_Cong_class N.is_Cong_classI R.con_implies_arr(1-2) con_char\<^sub>Q\<^sub>C\<^sub>N)
       show "\<And>t u. t \<frown> u \<Longrightarrow> \<lbrace>t \\ u\<rbrace> = \<lbrace>t\<rbrace> \<lbrace>\\\<rbrace> \<lbrace>u\<rbrace>"
         by (metis N.arr_in_Cong_class N.is_Cong_classI R.con_implies_arr(1-2) Resid_by_members)
     qed
 
     lemma quotient_is_simulation:
     shows "simulation resid Resid quot"
       ..
 
     (*
      * TODO: Show couniversality.
      *)
 
   end
 
   subsection "Identities form a Coherent Normal Sub-RTS"
 
   text \<open>
     We now show that the collection of identities of an RTS form a coherent normal sub-RTS,
     and that the associated congruence \<open>\<approx>\<close> coincides with \<open>\<sim>\<close>.
     Thus, every RTS can be factored by the relation \<open>\<sim>\<close> to obtain an extensional RTS.
     Although we could have shown that fact much earlier, we have delayed proving it so that
     we could simply obtain it as a special case of our general quotient result without
     redundant work.
   \<close>
 
   context rts
   begin
 
     interpretation normal_sub_rts resid \<open>Collect ide\<close>
     proof
       show "\<And>t. t \<in> Collect ide \<Longrightarrow> arr t"
         by blast
       show 1: "\<And>a. ide a \<Longrightarrow> a \<in> Collect ide"
         by blast
       show "\<And>u t. \<lbrakk>u \<in> Collect ide; coinitial t u\<rbrakk> \<Longrightarrow> u \\ t \<in> Collect ide"
         by (metis 1 CollectD arr_def coinitial_iff
             con_sym in_sourcesE in_sourcesI resid_ide_arr)
       show "\<And>u t. \<lbrakk>u \<in> Collect ide; t \\ u \<in> Collect ide\<rbrakk> \<Longrightarrow> t \<in> Collect ide"
         using ide_backward_stable by blast
       show "\<And>u t. \<lbrakk>u \<in> Collect ide; seq u t\<rbrakk> \<Longrightarrow> \<exists>v. composite_of u t v"
         by (metis composite_of_source_arr ide_def in_sourcesI mem_Collect_eq seq_def
             resid_source_in_targets)
       show "\<And>u t. \<lbrakk>u \<in> Collect ide; seq t u\<rbrakk> \<Longrightarrow> \<exists>v. composite_of t u v"
         by (metis arrE composite_of_arr_target in_sourcesI seqE mem_Collect_eq)
     qed
 
     lemma identities_form_normal_sub_rts:
     shows "normal_sub_rts resid (Collect ide)"
       ..
 
     interpretation coherent_normal_sub_rts resid \<open>Collect ide\<close>
       apply unfold_locales
       by (metis CollectD Cong\<^sub>0_reflexive Cong_closure_props(4) Cong_imp_arr(2)
                 arr_resid_iff_con resid_arr_ide)
 
     lemma identities_form_coherent_normal_sub_rts:
     shows "coherent_normal_sub_rts resid (Collect ide)"
       ..
  
     lemma Cong_iff_cong:
     shows "Cong t u \<longleftrightarrow> t \<sim> u"
       by (metis CollectD Cong_def ide_closed resid_arr_ide
           Cong_closure_props(3) Cong_imp_arr(2) arr_resid_iff_con)
 
   end
 
   section "Paths"
 
   text \<open>
     A \emph{path} in an RTS is a nonempty list of arrows such that the set
     of targets of each arrow suitably matches the set of sources of its successor.
     The residuation on the given RTS extends inductively to a residuation on
     paths, so that paths also form an RTS.  The append operation on lists
     yields a composite for each pair of compatible paths.
   \<close>
 
   locale paths_in_rts =
     R: rts
   begin
 
     fun Srcs
     where "Srcs [] = {}"
         | "Srcs [t] = R.sources t"
         | "Srcs (t # T) = R.sources t"
 
     fun Trgs
     where "Trgs [] = {}"
         | "Trgs [t] = R.targets t"
         | "Trgs (t # T) = Trgs T"
 
     fun Arr
     where "Arr [] = False"
         | "Arr [t] = R.arr t"
         | "Arr (t # T) = (R.arr t \<and> Arr T \<and> R.targets t \<subseteq> Srcs T)"
 
     fun Ide
     where "Ide [] = False"
         | "Ide [t] = R.ide t"
         | "Ide (t # T) = (R.ide t \<and> Ide T \<and> R.targets t \<subseteq> Srcs T)"
 
     lemma set_Arr_subset_arr:
     shows "Arr T \<Longrightarrow> set T \<subseteq> Collect R.arr"
       apply (induct T)
        apply auto
       using Arr.elims(2)
        apply blast
       by (metis Arr.simps(3) Ball_Collect list.set_cases)
 
     lemma Arr_imp_arr_hd [simp]:
     assumes "Arr T"
     shows "R.arr (hd T)"
       using assms
       by (metis Arr.simps(1) CollectD hd_in_set set_Arr_subset_arr subset_code(1))
 
     lemma Arr_imp_arr_last [simp]:
     assumes "Arr T"
     shows "R.arr (last T)"
       using assms
       by (metis Arr.simps(1) CollectD in_mono last_in_set set_Arr_subset_arr)
 
     lemma Arr_imp_Arr_tl [simp]:
     assumes "Arr T" and "tl T \<noteq> []"
     shows "Arr (tl T)"
       using assms
       by (metis Arr.simps(3) list.exhaust_sel list.sel(2))
 
     lemma set_Ide_subset_ide:
     shows "Ide T \<Longrightarrow> set T \<subseteq> Collect R.ide"
       apply (induct T)
        apply auto
       using Ide.elims(2)
        apply blast
       by (metis Ide.simps(3) Ball_Collect list.set_cases)
 
     lemma Ide_imp_Ide_hd [simp]:
     assumes "Ide T"
     shows "R.ide (hd T)"
       using assms
       by (metis Ide.simps(1) CollectD hd_in_set set_Ide_subset_ide subset_code(1))
 
     lemma Ide_imp_Ide_last [simp]:
     assumes "Ide T"
     shows "R.ide (last T)"
       using assms
       by (metis Ide.simps(1) CollectD in_mono last_in_set set_Ide_subset_ide)
 
     lemma Ide_imp_Ide_tl [simp]:
     assumes "Ide T" and "tl T \<noteq> []"
     shows "Ide (tl T)"
       using assms
       by (metis Ide.simps(3) list.exhaust_sel list.sel(2))
 
     lemma Ide_implies_Arr:
     shows "Ide T \<Longrightarrow> Arr T"
       apply (induct T)
        apply simp
       using Ide.elims(2) by fastforce
 
     lemma const_ide_is_Ide:
     shows "\<lbrakk>T \<noteq> []; R.ide (hd T); set T \<subseteq> {hd T}\<rbrakk> \<Longrightarrow> Ide T"
       apply (induct T)
        apply auto
       by (metis Ide.simps(2-3) R.ideE R.sources_resid Srcs.simps(2-3) empty_iff insert_iff
           list.exhaust_sel list.set_sel(1) order_refl subset_singletonD)
 
     lemma Ide_char:
     shows "Ide T \<longleftrightarrow> Arr T \<and> set T \<subseteq> Collect R.ide"
       apply (induct T)
        apply auto[1]
       by (metis Arr.simps(3) Ide.simps(2-3) Ide_implies_Arr empty_subsetI
           insert_subset list.simps(15) mem_Collect_eq neq_Nil_conv set_empty)
 
     lemma IdeI [intro]:
     assumes "Arr T" and "set T \<subseteq> Collect R.ide"
     shows "Ide T"
       using assms Ide_char by force
 
     lemma Arr_has_Src:
     shows "Arr T \<Longrightarrow> Srcs T \<noteq> {}"
       apply (cases T)
        apply simp
       by (metis R.arr_iff_has_source Srcs.elims Arr.elims(2) list.distinct(1) list.sel(1))
 
     lemma Arr_has_Trg:
     shows "Arr T \<Longrightarrow> Trgs T \<noteq> {}"
       using R.arr_iff_has_target
       apply (induct T)
        apply simp
       by (metis Arr.simps(2) Arr.simps(3) Trgs.simps(2-3) list.exhaust_sel)
 
     lemma Srcs_are_ide:
     shows "Srcs T \<subseteq> Collect R.ide"
       apply (cases T)
        apply simp
       by (metis (no_types, lifting) Srcs.elims list.distinct(1) mem_Collect_eq
           R.sources_def subsetI)
 
     lemma Trgs_are_ide:
     shows "Trgs T \<subseteq> Collect R.ide"
       apply (induct T)
        apply simp
       by (metis R.arr_iff_has_target R.sources_resid Srcs.simps(2) Trgs.simps(2-3)
                 Srcs_are_ide empty_subsetI list.exhaust R.arrE)
 
     lemma Srcs_are_con:
     assumes "a \<in> Srcs T" and "a' \<in> Srcs T"
     shows "a \<frown> a'"
       using assms
       by (metis Srcs.elims empty_iff R.sources_are_con)
 
     lemma Srcs_con_closed:
     assumes "a \<in> Srcs T" and "R.ide a'" and "a \<frown> a'"
     shows "a' \<in> Srcs T"
       using assms R.sources_con_closed
       apply (cases T, auto)
       by (metis Srcs.simps(2-3) neq_Nil_conv)
 
     lemma Srcs_eqI:
     assumes "Srcs T \<inter> Srcs T' \<noteq> {}"
     shows "Srcs T = Srcs T'"
       using assms R.sources_eqI
       apply (cases T; cases T')
          apply auto
        apply (metis IntI Srcs.simps(2-3) empty_iff neq_Nil_conv)
       by (metis Srcs.simps(2-3) assms neq_Nil_conv)
 
     lemma Trgs_are_con:
-    shows "\<And>b b'. \<lbrakk>b \<in> Trgs T; b' \<in> Trgs T\<rbrakk> \<Longrightarrow> b \<frown> b'"
+    shows "\<lbrakk>b \<in> Trgs T; b' \<in> Trgs T\<rbrakk> \<Longrightarrow> b \<frown> b'"
       apply (induct T)
        apply auto
       by (metis R.targets_are_con Trgs.simps(2-3) list.exhaust_sel)
 
     lemma Trgs_con_closed:
     shows "\<lbrakk>b \<in> Trgs T; R.ide b'; b \<frown> b'\<rbrakk> \<Longrightarrow> b' \<in> Trgs T"
       apply (induct T)
        apply auto
       by (metis R.targets_con_closed Trgs.simps(2-3) neq_Nil_conv)
 
     lemma Trgs_eqI:
     assumes "Trgs T \<inter> Trgs T' \<noteq> {}"
     shows "Trgs T = Trgs T'"
       using assms Trgs_are_ide Trgs_are_con Trgs_con_closed by blast
 
     lemma Srcs_simp\<^sub>P:
     assumes "Arr T"
     shows "Srcs T = R.sources (hd T)"
       using assms
       by (metis Arr_has_Src Srcs.simps(1) Srcs.simps(2) Srcs.simps(3) list.exhaust_sel)
 
     lemma Trgs_simp\<^sub>P:
     shows "Arr T \<Longrightarrow> Trgs T = R.targets (last T)"
       apply (induct T)
        apply simp
       by (metis Arr.simps(3) Trgs.simps(2) Trgs.simps(3) last_ConsL last_ConsR neq_Nil_conv)
 
     subsection "Residuation on Paths"
 
     text \<open>
       It was more difficult than I thought to get a correct formal definition for residuation
       on paths and to prove things from it.  Straightforward attempts to write a single
       recursive definition ran into problems with being able to prove termination,
       as well as getting the cases correct so that the domain of definition was symmetric.
       Eventually I found the definition below, which simplifies the termination proof
       to some extent through the use of two auxiliary functions, and which has a
       symmetric form that makes symmetry easier to prove.  However, there was still
       some difficulty in proving the recursive expansions with respect to cons and
       append that I needed.
     \<close>
 
     text \<open>
       The following defines residuation of a single transition along a path, yielding a transition.
     \<close>
 
     fun Resid1x  (infix "\<^sup>1\\\<^sup>*" 70)
     where "t \<^sup>1\\\<^sup>* [] = R.null"
         | "t \<^sup>1\\\<^sup>* [u] = t \\ u"
         | "t \<^sup>1\\\<^sup>* (u # U) = (t \\ u) \<^sup>1\\\<^sup>* U"
 
     text \<open>
       Next, we have residuation of a path along a single transition, yielding a path.
     \<close>
 
     fun Residx1  (infix "\<^sup>*\\\<^sup>1" 70)
     where "[] \<^sup>*\\\<^sup>1 u = []"
         | "[t] \<^sup>*\\\<^sup>1 u = (if t \<frown> u then [t \\ u] else [])"
         | "(t # T) \<^sup>*\\\<^sup>1 u =
              (if t \<frown> u \<and> T \<^sup>*\\\<^sup>1 (u \\ t) \<noteq> [] then (t \\ u) # T \<^sup>*\\\<^sup>1 (u \\ t) else [])"
 
     text \<open>
       Finally, residuation of a path along a path, yielding a path.
     \<close>
 
     function (sequential) Resid  (infix "\<^sup>*\\\<^sup>*" 70)
     where "[] \<^sup>*\\\<^sup>* _ = []"
         | "_ \<^sup>*\\\<^sup>* [] = []"
         | "[t] \<^sup>*\\\<^sup>* [u] = (if t \<frown> u then [t \\ u] else [])"
         | "[t] \<^sup>*\\\<^sup>* (u # U) =
              (if t \<frown> u \<and> (t \\ u) \<^sup>1\\\<^sup>* U \<noteq> R.null then [(t \\ u) \<^sup>1\\\<^sup>* U] else [])"
         | "(t # T) \<^sup>*\\\<^sup>* [u] =
              (if t \<frown> u \<and> T \<^sup>*\\\<^sup>1 (u \\ t) \<noteq> [] then (t \\ u) # (T \<^sup>*\\\<^sup>1 (u \\ t)) else [])"
         | "(t # T) \<^sup>*\\\<^sup>* (u # U) =
              (if t \<frown> u \<and> (t \\ u) \<^sup>1\\\<^sup>* U \<noteq> R.null \<and>
                  (T \<^sup>*\\\<^sup>1 (u \\ t)) \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>1 (t \\ u)) \<noteq> []
               then (t \\ u) \<^sup>1\\\<^sup>* U # (T \<^sup>*\\\<^sup>1 (u \\ t)) \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>1 (t \\ u))
               else [])"
       by pat_completeness auto
 
     text \<open>
       Residuation of a path along a single transition is length non-increasing.
       Actually, it is length-preserving, except in case the path and the transition
       are not consistent.  We will show that later, but for now this is what we
       need to establish termination for (\<open>\\<close>).
     \<close>
 
     lemma length_Residx1:
-    shows "\<And>u. length (T \<^sup>*\\\<^sup>1 u) \<le> length T"
-    proof (induct T)
+    shows "length (T \<^sup>*\\\<^sup>1 u) \<le> length T"
+    proof (induct T arbitrary: u)
       show "\<And>u. length ([] \<^sup>*\\\<^sup>1 u) \<le> length []"
         by simp
       fix t T u
       assume ind: "\<And>u. length (T \<^sup>*\\\<^sup>1 u) \<le> length T"
       show "length ((t # T) \<^sup>*\\\<^sup>1 u) \<le> length (t # T)"
         using ind
         by (cases T, cases "t \<frown> u", cases "T \<^sup>*\\\<^sup>1 (u \\ t)") auto
     qed
 
     termination Resid
     proof (relation "measure (\<lambda>(T, U). length T + length U)")
       show "wf (measure (\<lambda>(T, U). length T + length U))"
         by simp
       fix t t' T u U
       have "length ((t' # T) \<^sup>*\\\<^sup>1 (u \\ t)) + length (U \<^sup>*\\\<^sup>1 (t \\ u))
               < length (t # t' # T) + length (u # U)"
         using length_Residx1
         by (metis add_less_le_mono impossible_Cons le_neq_implies_less list.size(4) trans_le_add1)
       thus 1: "(((t' # T) \<^sup>*\\\<^sup>1 (u \\ t), U \<^sup>*\\\<^sup>1 (t \\ u)), t # t' # T, u # U)
                  \<in> measure (\<lambda>(T, U). length T + length U)"
         by simp
       show "(((t' # T) \<^sup>*\\\<^sup>1 (u \\ t), U \<^sup>*\\\<^sup>1 (t \\ u)), t # t' # T, u # U)
               \<in> measure (\<lambda>(T, U). length T + length U)"
         using 1 length_Residx1 by blast
       have "length (T \<^sup>*\\\<^sup>1 (u \\ t)) + length (U \<^sup>*\\\<^sup>1 (t \\ u)) \<le> length T + length U"
         using length_Residx1 by (simp add: add_mono)
       thus 2: "((T \<^sup>*\\\<^sup>1 (u \\ t), U \<^sup>*\\\<^sup>1 (t \\ u)), t # T, u # U)
                  \<in> measure (\<lambda>(T, U). length T + length U)"
         by simp
       show "((T \<^sup>*\\\<^sup>1 (u \\ t), U \<^sup>*\\\<^sup>1 (t \\ u)), t # T, u # U)
                \<in> measure (\<lambda>(T, U). length T + length U)"
         using 2 length_Residx1 by blast
     qed
 
     lemma Resid1x_null:
     shows "R.null \<^sup>1\\\<^sup>* T = R.null"
       apply (induct T)
        apply auto
       by (metis R.null_is_zero(1) Resid1x.simps(2-3) list.exhaust)
 
     lemma Resid1x_ide:
-    shows "\<And>a. \<lbrakk>R.ide a; a \<^sup>1\\\<^sup>* T \<noteq> R.null\<rbrakk> \<Longrightarrow> R.ide (a \<^sup>1\\\<^sup>* T)"
-    proof (induct T)
+    shows "\<lbrakk>R.ide a; a \<^sup>1\\\<^sup>* T \<noteq> R.null\<rbrakk> \<Longrightarrow> R.ide (a \<^sup>1\\\<^sup>* T)"
+    proof (induct T arbitrary: a)
       show "\<And>a. a \<^sup>1\\\<^sup>* [] \<noteq> R.null \<Longrightarrow> R.ide (a \<^sup>1\\\<^sup>* [])"
         by simp
       fix a t T
       assume a: "R.ide a"
       assume ind: "\<And>a. \<lbrakk>R.ide a; a \<^sup>1\\\<^sup>* T \<noteq> R.null\<rbrakk> \<Longrightarrow> R.ide (a \<^sup>1\\\<^sup>* T)"
       assume con: "a \<^sup>1\\\<^sup>* (t # T) \<noteq> R.null"
       have 1: "a \<frown> t"
         using con
         by (metis R.con_def Resid1x.simps(2-3) Resid1x_null list.exhaust)
       show "R.ide (a \<^sup>1\\\<^sup>* (t # T))"
         using a 1 con ind R.resid_ide_arr
         by (metis Resid1x.simps(2-3) list.exhaust)
     qed
 
     (*
      * TODO: Try to make this a definition, rather than an abbreviation.
      *
      * I made an attempt at this, but there are many, many places where the
      * definition needs to be unwound.  It is not clear how valuable it might
      * end up being to have this as a definition.
      *)
     abbreviation Con  (infix "\<^sup>*\<frown>\<^sup>*" 50)
     where "T \<^sup>*\<frown>\<^sup>* U \<equiv> T \<^sup>*\\\<^sup>* U \<noteq> []"
 
     lemma Con_sym1:
-    shows "\<And>u. T \<^sup>*\\\<^sup>1 u \<noteq> [] \<longleftrightarrow> u \<^sup>1\\\<^sup>* T \<noteq> R.null"
-    proof (induct T)
+    shows "T \<^sup>*\\\<^sup>1 u \<noteq> [] \<longleftrightarrow> u \<^sup>1\\\<^sup>* T \<noteq> R.null"
+    proof (induct T arbitrary: u)
       show "\<And>u. [] \<^sup>*\\\<^sup>1 u \<noteq> [] \<longleftrightarrow> u \<^sup>1\\\<^sup>* [] \<noteq> R.null"
         by simp
       show "\<And>t T u. (\<And>u. T \<^sup>*\\\<^sup>1 u \<noteq> [] \<longleftrightarrow> u \<^sup>1\\\<^sup>* T \<noteq> R.null)
                         \<Longrightarrow> (t # T) \<^sup>*\\\<^sup>1 u \<noteq> [] \<longleftrightarrow> u \<^sup>1\\\<^sup>* (t # T) \<noteq> R.null"
       proof -
         fix t T u
         assume ind: "\<And>u. T \<^sup>*\\\<^sup>1 u \<noteq> [] \<longleftrightarrow> u \<^sup>1\\\<^sup>* T \<noteq> R.null"
         show "(t # T) \<^sup>*\\\<^sup>1 u \<noteq> [] \<longleftrightarrow> u \<^sup>1\\\<^sup>* (t # T) \<noteq> R.null"
         proof
           show "(t # T) \<^sup>*\\\<^sup>1 u \<noteq> [] \<Longrightarrow> u \<^sup>1\\\<^sup>* (t # T) \<noteq> R.null"
             by (metis R.con_sym Resid1x.simps(2-3) Residx1.simps(2-3)
                 ind neq_Nil_conv R.conE)
           show "u \<^sup>1\\\<^sup>* (t # T) \<noteq> R.null \<Longrightarrow> (t # T) \<^sup>*\\\<^sup>1 u \<noteq> []"
             using ind R.con_sym
             apply (cases T)
              apply auto
             by (metis R.conI Resid1x_null)
         qed
       qed
     qed
 
     lemma Con_sym_ind:
-    shows "\<And>T U. length T + length U \<le> n \<Longrightarrow> T \<^sup>*\<frown>\<^sup>* U \<longleftrightarrow> U \<^sup>*\<frown>\<^sup>* T"
-    proof (induct n)
+    shows "length T + length U \<le> n \<Longrightarrow> T \<^sup>*\<frown>\<^sup>* U \<longleftrightarrow> U \<^sup>*\<frown>\<^sup>* T"
+    proof (induct n arbitrary: T U)
       show "\<And>T U. length T + length U \<le> 0 \<Longrightarrow> T \<^sup>*\<frown>\<^sup>* U \<longleftrightarrow> U \<^sup>*\<frown>\<^sup>* T"
         by simp
       fix n and T U :: "'a list"
       assume ind: "\<And>T U. length T + length U \<le> n \<Longrightarrow> T \<^sup>*\<frown>\<^sup>* U \<longleftrightarrow> U \<^sup>*\<frown>\<^sup>* T"
       assume 1: "length T + length U \<le> Suc n"
       show "T \<^sup>*\<frown>\<^sup>* U \<longleftrightarrow> U \<^sup>*\<frown>\<^sup>* T"
         using R.con_sym Con_sym1
           apply (cases T; cases U)
            apply auto[3]
       proof -
         fix t u T' U'
         assume T: "T = t # T'" and U: "U = u # U'"
         show "T \<^sup>*\<frown>\<^sup>* U \<longleftrightarrow> U \<^sup>*\<frown>\<^sup>* T"
         proof (cases "T' = []")
           show "T' = [] \<Longrightarrow> T \<^sup>*\<frown>\<^sup>* U \<longleftrightarrow> U \<^sup>*\<frown>\<^sup>* T"
             using T U Con_sym1 R.con_sym
             by (cases U') auto
           show "T' \<noteq> [] \<Longrightarrow> T \<^sup>*\<frown>\<^sup>* U \<longleftrightarrow> U \<^sup>*\<frown>\<^sup>* T"
           proof (cases "U' = []")
             show "\<lbrakk>T' \<noteq> []; U' = []\<rbrakk> \<Longrightarrow> T \<^sup>*\<frown>\<^sup>* U \<longleftrightarrow> U \<^sup>*\<frown>\<^sup>* T"
               using T U R.con_sym Con_sym1
               by (cases T') auto
             show "\<lbrakk>T' \<noteq> []; U' \<noteq> []\<rbrakk> \<Longrightarrow> T \<^sup>*\<frown>\<^sup>* U \<longleftrightarrow> U \<^sup>*\<frown>\<^sup>* T"
             proof -
               assume T': "T' \<noteq> []" and U': "U' \<noteq> []"
               have 2: "length (U' \<^sup>*\\\<^sup>1 (t \\ u)) + length (T' \<^sup>*\\\<^sup>1 (u \\ t)) \<le> n"
               proof -
                 have "length (U' \<^sup>*\\\<^sup>1 (t \\ u)) + length (T' \<^sup>*\\\<^sup>1 (u \\ t))
                          \<le> length U' + length T'"
                   by (simp add: add_le_mono length_Residx1)
                 also have "... \<le> length T' + length U'"
                   using T' add.commute not_less_eq_eq by auto
                 also have "... \<le> n"
                   using 1 T U by simp
                 finally show ?thesis by blast
               qed
               show "T \<^sup>*\<frown>\<^sup>* U \<longleftrightarrow> U \<^sup>*\<frown>\<^sup>* T"
               proof
                 assume Con: "T \<^sup>*\<frown>\<^sup>* U"
                 have 3: "t \<frown> u \<and> T' \<^sup>*\\\<^sup>1 (u \\ t) \<noteq> [] \<and> (t \\ u) \<^sup>1\\\<^sup>* U' \<noteq> R.null \<and>
                          (T' \<^sup>*\\\<^sup>1 (u \\ t)) \<^sup>*\\\<^sup>* (U' \<^sup>*\\\<^sup>1 (t \\ u)) \<noteq> []"
                   using Con T U T' U' Con_sym1
                   apply (cases T', cases U')
                     apply simp_all
                   by (metis Resid.simps(1) Resid.simps(6) neq_Nil_conv)
                 hence "u \<frown> t \<and> U' \<^sup>*\\\<^sup>1 (t \\ u) \<noteq> [] \<and> (u \\ t) \<^sup>1\\\<^sup>* T' \<noteq> R.null"
                   using T' U' R.con_sym Con_sym1 by simp
                 moreover have "(U' \<^sup>*\\\<^sup>1 (t \\ u)) \<^sup>*\\\<^sup>* (T' \<^sup>*\\\<^sup>1 (u \\ t)) \<noteq> []"
                   using 2 3 ind by simp
                 ultimately show "U \<^sup>*\<frown>\<^sup>* T"
                   using T U T' U'
                   by (cases T'; cases U') auto
                 next
                 assume Con: "U \<^sup>*\<frown>\<^sup>* T"
                 have 3: "u \<frown> t \<and> U' \<^sup>*\\\<^sup>1 (t \\ u) \<noteq> [] \<and> (u \\ t) \<^sup>1\\\<^sup>* T' \<noteq> R.null \<and>
                          (U' \<^sup>*\\\<^sup>1 (t \\ u)) \<^sup>*\\\<^sup>* (T' \<^sup>*\\\<^sup>1 (u \\ t)) \<noteq> []"
                   using Con T U T' U' Con_sym1
                   apply (cases T'; cases U')
                      apply auto
                    apply argo
                   by force
                 hence "t \<frown> u \<and> T' \<^sup>*\\\<^sup>1 (u \\ t) \<noteq> [] \<and> (t \\ u) \<^sup>1\\\<^sup>* U' \<noteq> R.null"
                   using T' U' R.con_sym Con_sym1 by simp
                 moreover have "(T' \<^sup>*\\\<^sup>1 (u \\ t)) \<^sup>*\\\<^sup>* (U' \<^sup>*\\\<^sup>1 (t \\ u)) \<noteq> []"
                   using 2 3 ind by simp
                 ultimately show "T \<^sup>*\<frown>\<^sup>* U"
                   using T U T' U'
                   by (cases T'; cases U') auto
               qed
             qed
           qed
         qed
       qed
     qed
 
     lemma Con_sym:
     shows "T \<^sup>*\<frown>\<^sup>* U \<longleftrightarrow> U \<^sup>*\<frown>\<^sup>* T"
       using Con_sym_ind by blast
 
     lemma Residx1_as_Resid:
     shows "T \<^sup>*\\\<^sup>1 u = T \<^sup>*\\\<^sup>* [u]"
     proof (induct T)
       show "[] \<^sup>*\\\<^sup>1 u = [] \<^sup>*\\\<^sup>* [u]" by simp
       fix t T
       assume ind: "T \<^sup>*\\\<^sup>1 u = T \<^sup>*\\\<^sup>* [u]"
       show "(t # T) \<^sup>*\\\<^sup>1 u = (t # T) \<^sup>*\\\<^sup>* [u]"
         by (cases T) auto
     qed
 
     lemma Resid1x_as_Resid':
     shows "t \<^sup>1\\\<^sup>* U = (if [t] \<^sup>*\\\<^sup>* U \<noteq> [] then hd ([t] \<^sup>*\\\<^sup>* U) else R.null)"
     proof (induct U)
       show "t \<^sup>1\\\<^sup>* [] = (if [t] \<^sup>*\\\<^sup>* [] \<noteq> [] then hd ([t] \<^sup>*\\\<^sup>* []) else R.null)" by simp
       fix u U
       assume ind: "t \<^sup>1\\\<^sup>* U = (if [t] \<^sup>*\\\<^sup>* U \<noteq> [] then hd ([t] \<^sup>*\\\<^sup>* U) else R.null)"
       show "t \<^sup>1\\\<^sup>* (u # U) = (if [t] \<^sup>*\\\<^sup>* (u # U) \<noteq> [] then hd ([t] \<^sup>*\\\<^sup>* (u # U)) else R.null)"
         using Resid1x_null
         by (cases U) auto
     qed
 
     text \<open>
       The following recursive expansion for consistency of paths is an intermediate
       result that is not yet quite in the form we really want.
     \<close>
 
     lemma Con_rec:
     shows "[t] \<^sup>*\<frown>\<^sup>* [u] \<longleftrightarrow> t \<frown> u"
     and "T \<noteq> [] \<Longrightarrow> t # T \<^sup>*\<frown>\<^sup>* [u] \<longleftrightarrow> t \<frown> u \<and> T \<^sup>*\<frown>\<^sup>* [u \\ t]"
     and "U \<noteq> [] \<Longrightarrow> [t] \<^sup>*\<frown>\<^sup>* (u # U) \<longleftrightarrow> t \<frown> u \<and> [t \\ u] \<^sup>*\<frown>\<^sup>* U"
     and "\<lbrakk>T \<noteq> []; U \<noteq> []\<rbrakk> \<Longrightarrow>
            t # T \<^sup>*\<frown>\<^sup>* u # U \<longleftrightarrow> t \<frown> u \<and> T \<^sup>*\<frown>\<^sup>* [u \\ t] \<and> [t \\ u] \<^sup>*\<frown>\<^sup>* U \<and>
                                T \<^sup>*\\\<^sup>* [u \\ t] \<^sup>*\<frown>\<^sup>* U \<^sup>*\\\<^sup>* [t \\ u]"
     proof -
       show "[t] \<^sup>*\<frown>\<^sup>* [u] \<longleftrightarrow> t \<frown> u"
         by simp
       show "T \<noteq> [] \<Longrightarrow> t # T \<^sup>*\<frown>\<^sup>* [u] \<longleftrightarrow> t \<frown> u \<and> T \<^sup>*\<frown>\<^sup>* [u \\ t]"
         using Residx1_as_Resid
         by (cases T) auto
       show "U \<noteq> [] \<Longrightarrow> [t] \<^sup>*\<frown>\<^sup>* (u # U) \<longleftrightarrow> t \<frown> u \<and> [t \\ u] \<^sup>*\<frown>\<^sup>* U"
         using Resid1x_as_Resid' Con_sym Con_sym1 Resid1x.simps(3) Residx1_as_Resid
         by (cases U) auto
       show "\<lbrakk>T \<noteq> []; U \<noteq> []\<rbrakk> \<Longrightarrow>
             t # T \<^sup>*\<frown>\<^sup>* u # U \<longleftrightarrow> t \<frown> u \<and> T \<^sup>*\<frown>\<^sup>* [u \\ t] \<and> [t \\ u] \<^sup>*\<frown>\<^sup>* U \<and>
                                T \<^sup>*\\\<^sup>* [u \\ t] \<^sup>*\<frown>\<^sup>* U \<^sup>*\\\<^sup>* [t \\ u]"
         using Residx1_as_Resid Resid1x_as_Resid' Con_sym1 Con_sym R.con_sym
         by (cases T; cases U) auto
     qed
 
     text \<open>
       This version is a more appealing form of the previously proved fact \<open>Resid1x_as_Resid'\<close>.
     \<close>
 
     lemma Resid1x_as_Resid:
     assumes "[t] \<^sup>*\\\<^sup>* U \<noteq> []"
     shows "[t] \<^sup>*\\\<^sup>* U = [t \<^sup>1\\\<^sup>* U]"
       using assms Con_rec(2,4)
       apply (cases U; cases "tl U")
          apply auto
       by argo+  (* TODO: Why can auto no longer complete this proof? *)
 
    text \<open>
      The following is an intermediate version of a recursive expansion for residuation,
      to be improved subsequently.
    \<close>
 
    lemma Resid_rec:
     shows [simp]: "[t] \<^sup>*\<frown>\<^sup>* [u] \<Longrightarrow> [t] \<^sup>*\\\<^sup>* [u] = [t \\ u]"
     and "\<lbrakk>T \<noteq> []; t # T \<^sup>*\<frown>\<^sup>* [u]\<rbrakk> \<Longrightarrow> (t # T) \<^sup>*\\\<^sup>* [u] = (t \\ u) # (T \<^sup>*\\\<^sup>* [u \\ t])"
     and "\<lbrakk>U \<noteq> []; Con [t] (u # U)\<rbrakk> \<Longrightarrow> [t] \<^sup>*\\\<^sup>* (u # U) = [t \\ u] \<^sup>*\\\<^sup>* U"
     and "\<lbrakk>T \<noteq> []; U \<noteq> []; Con (t # T) (u # U)\<rbrakk> \<Longrightarrow>
          (t # T) \<^sup>*\\\<^sup>* (u # U) = ([t \\ u] \<^sup>*\\\<^sup>* U) @ ((T \<^sup>*\\\<^sup>* [u \\ t]) \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* [t \\ u]))"
     proof -
       show "[t] \<^sup>*\<frown>\<^sup>* [u] \<Longrightarrow> Resid [t] [u] = [t \\ u]"
         by (meson Resid.simps(3))
       show "\<lbrakk>T \<noteq> []; t # T \<^sup>*\<frown>\<^sup>* [u]\<rbrakk> \<Longrightarrow> (t # T) \<^sup>*\\\<^sup>* [u] = (t \\ u) # (T \<^sup>*\\\<^sup>* [u \\ t])"
         using Residx1_as_Resid
         by (metis Residx1.simps(3) list.exhaust_sel)
       show 1: "\<lbrakk>U \<noteq> []; [t] \<^sup>*\<frown>\<^sup>* u # U\<rbrakk> \<Longrightarrow> [t] \<^sup>*\\\<^sup>* (u # U) = [t \\ u] \<^sup>*\\\<^sup>* U"
         by (metis Con_rec(3) Resid1x.simps(3) Resid1x_as_Resid list.exhaust)
       show "\<lbrakk>T \<noteq> []; U \<noteq> []; t # T \<^sup>*\<frown>\<^sup>* u # U\<rbrakk> \<Longrightarrow>
              (t # T) \<^sup>*\\\<^sup>* (u # U) = ([t \\ u] \<^sup>*\\\<^sup>* U) @ ((T \<^sup>*\\\<^sup>* [u \\ t]) \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* [t \\ u]))"
       proof -
         assume T: "T \<noteq> []" and U: "U \<noteq> []" and Con: "Con (t # T) (u # U)"
         have tu: "t \<frown> u"
           using Con Con_rec by metis
         have "(t # T) \<^sup>*\\\<^sup>* (u # U) = ((t \\ u) \<^sup>1\\\<^sup>* U) # ((T \<^sup>*\\\<^sup>1 (u \\ t)) \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>1 (t \\ u)))"
           using T U Con tu
           by (cases T; cases U) auto
         also have "... = ([t \\ u] \<^sup>*\\\<^sup>* U) @ ((T \<^sup>*\\\<^sup>* [u \\ t]) \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* [t \\ u]))"
           using T U Con tu Con_rec(4) Resid1x_as_Resid Residx1_as_Resid by force
         finally show ?thesis by simp
       qed
     qed
 
     text \<open>
       For consistent paths, residuation is length-preserving.
     \<close>
 
     lemma length_Resid_ind:
-    shows "\<And>T U. \<lbrakk>length T + length U \<le> n; T \<^sup>*\<frown>\<^sup>* U\<rbrakk> \<Longrightarrow> length (T \<^sup>*\\\<^sup>* U) = length T"
-      apply (induct n)
+    shows "\<lbrakk>length T + length U \<le> n; T \<^sup>*\<frown>\<^sup>* U\<rbrakk> \<Longrightarrow> length (T \<^sup>*\\\<^sup>* U) = length T"
+      apply (induct n arbitrary: T U)
        apply simp
     proof -
       fix n T U
       assume ind: "\<And>T U. \<lbrakk>length T + length U \<le> n; T \<^sup>*\<frown>\<^sup>* U\<rbrakk>
                             \<Longrightarrow> length (T \<^sup>*\\\<^sup>* U) = length T"
       assume Con: "T \<^sup>*\<frown>\<^sup>* U"
       assume len: "length T + length U \<le> Suc n"
       show "length (T \<^sup>*\\\<^sup>* U) = length T"
         using Con len ind Resid1x_as_Resid length_Cons Con_rec(2) Resid_rec(2)
         apply (cases T; cases U)
            apply auto
         apply (cases "tl T = []"; cases "tl U = []")
            apply auto
           apply metis
          apply fastforce
       proof -
         fix t T' u U'
         assume T: "T = t # T'" and U: "U = u # U'"
         assume T': "T' \<noteq> []" and U': "U' \<noteq> []"
         show "length ((t # T') \<^sup>*\\\<^sup>* (u # U')) = Suc (length T')"
           using Con Con_rec(4) Con_sym Resid_rec(4) T T' U U' ind len by auto
       qed
     qed
 
     lemma length_Resid:
     assumes "T \<^sup>*\<frown>\<^sup>* U"
     shows "length (T \<^sup>*\\\<^sup>* U) = length T"
       using assms length_Resid_ind by auto
 
     lemma Con_initial_left:
-    shows "\<And>t T. t # T \<^sup>*\<frown>\<^sup>* U \<Longrightarrow> [t] \<^sup>*\<frown>\<^sup>* U"
+    shows "t # T \<^sup>*\<frown>\<^sup>* U \<Longrightarrow> [t] \<^sup>*\<frown>\<^sup>* U"
       apply (induct U)
        apply simp
       by (metis Con_rec(1-4))
 
     lemma Con_initial_right:
-    shows "\<And>u U. T \<^sup>*\<frown>\<^sup>* u # U \<Longrightarrow> T \<^sup>*\<frown>\<^sup>* [u]"
+    shows "T \<^sup>*\<frown>\<^sup>* u # U \<Longrightarrow> T \<^sup>*\<frown>\<^sup>* [u]"
       apply (induct T)
         apply simp
       by (metis Con_rec(1-4))
 
     lemma Resid_cons_ind:
-    shows "\<And>T U. \<lbrakk>T \<noteq> []; U \<noteq> []; length T + length U \<le> n\<rbrakk> \<Longrightarrow>
-                   (\<forall>t. t # T \<^sup>*\<frown>\<^sup>* U \<longleftrightarrow> [t] \<^sup>*\<frown>\<^sup>* U \<and> T \<^sup>*\<frown>\<^sup>* U \<^sup>*\\\<^sup>* [t]) \<and>
-                   (\<forall>u. T \<^sup>*\<frown>\<^sup>* u # U \<longleftrightarrow> T \<^sup>*\<frown>\<^sup>* [u] \<and> T \<^sup>*\\\<^sup>* [u] \<^sup>*\<frown>\<^sup>* U) \<and>
-                   (\<forall>t. t # T \<^sup>*\<frown>\<^sup>* U \<longrightarrow> (t # T) \<^sup>*\\\<^sup>* U = [t] \<^sup>*\\\<^sup>* U @ T \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* [t])) \<and>
-                   (\<forall>u. T \<^sup>*\<frown>\<^sup>* u # U \<longrightarrow> T \<^sup>*\\\<^sup>* (u # U) = (T \<^sup>*\\\<^sup>* [u]) \<^sup>*\\\<^sup>* U)"
-    proof (induct n)
+    shows "\<lbrakk>T \<noteq> []; U \<noteq> []; length T + length U \<le> n\<rbrakk> \<Longrightarrow>
+             (\<forall>t. t # T \<^sup>*\<frown>\<^sup>* U \<longleftrightarrow> [t] \<^sup>*\<frown>\<^sup>* U \<and> T \<^sup>*\<frown>\<^sup>* U \<^sup>*\\\<^sup>* [t]) \<and>
+             (\<forall>u. T \<^sup>*\<frown>\<^sup>* u # U \<longleftrightarrow> T \<^sup>*\<frown>\<^sup>* [u] \<and> T \<^sup>*\\\<^sup>* [u] \<^sup>*\<frown>\<^sup>* U) \<and>
+             (\<forall>t. t # T \<^sup>*\<frown>\<^sup>* U \<longrightarrow> (t # T) \<^sup>*\\\<^sup>* U = [t] \<^sup>*\\\<^sup>* U @ T \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* [t])) \<and>
+             (\<forall>u. T \<^sup>*\<frown>\<^sup>* u # U \<longrightarrow> T \<^sup>*\\\<^sup>* (u # U) = (T \<^sup>*\\\<^sup>* [u]) \<^sup>*\\\<^sup>* U)"
+    proof (induct n arbitrary: T U)
       show "\<And>T U. \<lbrakk>T \<noteq> []; U \<noteq> []; length T + length U \<le> 0\<rbrakk> \<Longrightarrow>
                    (\<forall>t. t # T \<^sup>*\<frown>\<^sup>* U \<longleftrightarrow> [t] \<^sup>*\<frown>\<^sup>* U \<and> T \<^sup>*\<frown>\<^sup>* U \<^sup>*\\\<^sup>* [t]) \<and>
                    (\<forall>u. T \<^sup>*\<frown>\<^sup>* u # U \<longleftrightarrow> T \<^sup>*\<frown>\<^sup>* [u] \<and> T \<^sup>*\\\<^sup>* [u] \<^sup>*\<frown>\<^sup>* U) \<and>
                    (\<forall>t. t # T \<^sup>*\<frown>\<^sup>* U \<longrightarrow> (t # T) \<^sup>*\\\<^sup>* U = [t] \<^sup>*\\\<^sup>* U @ T \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* [t])) \<and>
                    (\<forall>u. T \<^sup>*\<frown>\<^sup>* u # U \<longrightarrow> T \<^sup>*\\\<^sup>* (u # U) = (T \<^sup>*\\\<^sup>* [u]) \<^sup>*\\\<^sup>* U)"
         by simp
       fix n and T U :: "'a list"
       assume ind: "\<And>T U. \<lbrakk>T \<noteq> []; U \<noteq> []; length T + length U \<le> n\<rbrakk> \<Longrightarrow>
                    (\<forall>t. t # T \<^sup>*\<frown>\<^sup>* U \<longleftrightarrow> [t] \<^sup>*\<frown>\<^sup>* U \<and> T \<^sup>*\<frown>\<^sup>* U \<^sup>*\\\<^sup>* [t]) \<and>
                    (\<forall>u. T \<^sup>*\<frown>\<^sup>* u # U \<longleftrightarrow> T \<^sup>*\<frown>\<^sup>* [u] \<and> T \<^sup>*\\\<^sup>* [u] \<^sup>*\<frown>\<^sup>* U) \<and>
                    (\<forall>t. t # T \<^sup>*\<frown>\<^sup>* U \<longrightarrow> (t # T) \<^sup>*\\\<^sup>* U = [t] \<^sup>*\\\<^sup>* U @ T \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* [t])) \<and>
                    (\<forall>u. T \<^sup>*\<frown>\<^sup>* u # U \<longrightarrow> T \<^sup>*\\\<^sup>* (u # U) = (T \<^sup>*\\\<^sup>* [u]) \<^sup>*\\\<^sup>* U)"
       assume T: "T \<noteq> []" and U: "U \<noteq> []"
       assume len: "length T + length U \<le> Suc n"
       show "(\<forall>t. t # T \<^sup>*\<frown>\<^sup>* U \<longleftrightarrow> [t] \<^sup>*\<frown>\<^sup>* U \<and> T \<^sup>*\<frown>\<^sup>* U \<^sup>*\\\<^sup>* [t]) \<and>
             (\<forall>u. T \<^sup>*\<frown>\<^sup>* u # U \<longleftrightarrow> T \<^sup>*\<frown>\<^sup>* [u] \<and> T \<^sup>*\\\<^sup>* [u] \<^sup>*\<frown>\<^sup>* U) \<and>
             (\<forall>t. t # T \<^sup>*\<frown>\<^sup>* U \<longrightarrow> (t # T) \<^sup>*\\\<^sup>* U = [t] \<^sup>*\\\<^sup>* U @ T \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* [t])) \<and>
             (\<forall>u. T \<^sup>*\<frown>\<^sup>* u # U \<longrightarrow> T \<^sup>*\\\<^sup>* (u # U) = (T \<^sup>*\\\<^sup>* [u]) \<^sup>*\\\<^sup>* U)"
       proof (intro allI conjI iffI impI)
         fix t
         show 1: "t # T \<^sup>*\<frown>\<^sup>* U \<Longrightarrow> (t # T) \<^sup>*\\\<^sup>* U = [t] \<^sup>*\\\<^sup>* U @ T \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* [t])"
         proof (cases U)
           show "U = [] \<Longrightarrow> ?thesis"
             using U by simp
           fix u U'
           assume U: "U = u # U'"
           assume Con: "t # T \<^sup>*\<frown>\<^sup>* U"
           show ?thesis
           proof (cases "U' = []")
             show "U' = [] \<Longrightarrow> ?thesis"
               using T U Con R.con_sym Con_rec(2) Resid_rec(2) by auto
             assume U': "U' \<noteq> []"
             have "(t # T) \<^sup>*\\\<^sup>* U = [t \\ u] \<^sup>*\\\<^sup>* U' @ (T \<^sup>*\\\<^sup>* [u \\ t]) \<^sup>*\\\<^sup>* (U' \<^sup>*\\\<^sup>* [t \\ u])"
               using T U U' Con Resid_rec(4) by fastforce
             also have 1: "... = [t] \<^sup>*\\\<^sup>* U @ (T \<^sup>*\\\<^sup>* [u \\ t]) \<^sup>*\\\<^sup>* (U' \<^sup>*\\\<^sup>* [t \\ u])"
               using T U U' Con Con_rec(3-4) Resid_rec(3) by auto
             also have "... = [t] \<^sup>*\\\<^sup>* U @ T \<^sup>*\\\<^sup>* ((u \\ t) # (U' \<^sup>*\\\<^sup>* [t \\ u]))"
             proof -
               have "T \<^sup>*\\\<^sup>* ((u \\ t) # (U' \<^sup>*\\\<^sup>* [t \\ u])) = (T \<^sup>*\\\<^sup>* [u \\ t]) \<^sup>*\\\<^sup>* (U' \<^sup>*\\\<^sup>* [t \\ u])"
                 using T U U' ind [of T "U' \<^sup>*\\\<^sup>* [t \\ u]"] Con Con_rec(4) Con_sym len length_Resid
                 by fastforce
               thus ?thesis by auto
             qed
             also have "... = [t] \<^sup>*\\\<^sup>* U @ T \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* [t])"
               using T U U' 1 Con Con_rec(4) Con_sym1 Residx1_as_Resid
                     Resid1x_as_Resid Resid_rec(2) Con_sym Con_initial_left
               by auto
             finally show ?thesis by simp
           qed
         qed
         show "t # T \<^sup>*\<frown>\<^sup>* U \<Longrightarrow> [t] \<^sup>*\<frown>\<^sup>* U"
           by (simp add: Con_initial_left)
         show "t # T \<^sup>*\<frown>\<^sup>* U \<Longrightarrow> T \<^sup>*\<frown>\<^sup>* (U \<^sup>*\\\<^sup>* [t])"
           by (metis "1" Suc_inject T append_Nil2 length_0_conv length_Cons length_Resid)
         show "[t] \<^sup>*\<frown>\<^sup>* U \<and> T \<^sup>*\<frown>\<^sup>* U \<^sup>*\\\<^sup>* [t] \<Longrightarrow> t # T \<^sup>*\<frown>\<^sup>* U"
         proof (cases U)
           show "\<lbrakk>[t] \<^sup>*\<frown>\<^sup>* U \<and> T \<^sup>*\<frown>\<^sup>* U \<^sup>*\\\<^sup>* [t]; U = []\<rbrakk> \<Longrightarrow> t # T \<^sup>*\<frown>\<^sup>* U"
             using U by simp
           fix u U'
           assume U: "U = u # U'"
           assume Con: "[t] \<^sup>*\<frown>\<^sup>* U \<and> T \<^sup>*\<frown>\<^sup>* U \<^sup>*\\\<^sup>* [t]"
           show "t # T \<^sup>*\<frown>\<^sup>* U"
           proof (cases "U' = []")
             show "U' = [] \<Longrightarrow> ?thesis"
               using T U Con
               by (metis Con_rec(2) Resid.simps(3) R.con_sym)
             assume U': "U' \<noteq> []"
             show ?thesis
             proof -
               have "t \<frown> u"
                 using T U U' Con Con_rec(3) by blast
               moreover have "T \<^sup>*\<frown>\<^sup>* [u \\ t]"
                 using T U U' Con Con_initial_right Con_sym1 Residx1_as_Resid
                       Resid1x_as_Resid Resid_rec(2)
                 by (metis Con_sym)
               moreover have "[t \\ u] \<^sup>*\<frown>\<^sup>* U'"
                 using T U U' Con Resid_rec(3) by force
               moreover have "T \<^sup>*\\\<^sup>* [u \\ t] \<^sup>*\<frown>\<^sup>* U' \<^sup>*\\\<^sup>* [t \\ u]"
                 by (metis (no_types, opaque_lifting) Con Con_sym Resid_rec(2) Suc_le_mono
                     T U U' add_Suc_right calculation(3) ind len length_Cons length_Resid)
               ultimately show ?thesis
                 using T U U' Con_rec(4) by simp
             qed
           qed
         qed
         next
         fix u
         show 1: "T \<^sup>*\<frown>\<^sup>* u # U \<Longrightarrow> T \<^sup>*\\\<^sup>* (u # U) = (T \<^sup>*\\\<^sup>* [u]) \<^sup>*\\\<^sup>* U"
         proof (cases T)
           show 2: "\<lbrakk>T \<^sup>*\<frown>\<^sup>* u # U; T = []\<rbrakk> \<Longrightarrow> T \<^sup>*\\\<^sup>* (u # U) = (T \<^sup>*\\\<^sup>* [u]) \<^sup>*\\\<^sup>* U"
             using T by simp
           fix t T'
           assume T: "T = t # T'"
           assume Con: "T \<^sup>*\<frown>\<^sup>* u # U"
           show ?thesis
           proof (cases "T' = []")
             show "T' = [] \<Longrightarrow> ?thesis"
               using T U Con Con_rec(3) Resid1x_as_Resid Resid_rec(3) by force
             assume T': "T' \<noteq> []"
             have "T \<^sup>*\\\<^sup>* (u # U) = [t \\ u] \<^sup>*\\\<^sup>* U @ (T' \<^sup>*\\\<^sup>* [u \\ t]) \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* [t \\ u])"
               using T U T' Con Resid_rec(4) [of T' U t u] by simp
             also have "... = ((t \\ u) # (T' \<^sup>*\\\<^sup>* [u \\ t])) \<^sup>*\\\<^sup>* U"
             proof -
               have "length (T' \<^sup>*\\\<^sup>* [u \\ t]) + length U \<le> n"
                 by (metis (no_types, lifting) Con Con_rec(4) One_nat_def Suc_eq_plus1 Suc_leI
                     T T' U add_Suc le_less_trans len length_Resid lessI list.size(4)
                     not_le)
               thus ?thesis
                 using ind [of "T' \<^sup>*\\\<^sup>* [u \\ t]" U] Con Con_rec(4) T T' U by auto
             qed
             also have "... = (T \<^sup>*\\\<^sup>* [u]) \<^sup>*\\\<^sup>* U"
               using T U T' Con Con_rec(2,4) Resid_rec(2) by force
             finally show ?thesis by simp
           qed
         qed
         show "T \<^sup>*\<frown>\<^sup>* u # U \<Longrightarrow> T \<^sup>*\<frown>\<^sup>* [u]"
           using 1 by force
         show "T \<^sup>*\<frown>\<^sup>* u # U \<Longrightarrow> T \<^sup>*\\\<^sup>* [u] \<^sup>*\<frown>\<^sup>* U"
           using 1 by fastforce
         show "T \<^sup>*\<frown>\<^sup>* [u] \<and> T \<^sup>*\\\<^sup>* [u] \<^sup>*\<frown>\<^sup>* U \<Longrightarrow> T \<^sup>*\<frown>\<^sup>* u # U"
         proof (cases T)
           show "\<lbrakk>T \<^sup>*\<frown>\<^sup>* [u] \<and> T \<^sup>*\\\<^sup>* [u] \<^sup>*\<frown>\<^sup>* U; T = []\<rbrakk> \<Longrightarrow> T \<^sup>*\<frown>\<^sup>* u # U"
             using T by simp
           fix t T'
           assume T: "T = t # T'"
           assume Con: "T \<^sup>*\<frown>\<^sup>* [u] \<and> T \<^sup>*\\\<^sup>* [u] \<^sup>*\<frown>\<^sup>* U"
           show "Con T (u # U)"
           proof (cases "T' = []")
             show "T' = [] \<Longrightarrow> ?thesis"
               using Con T U Con_rec(1,3) by auto
             assume T': "T' \<noteq> []"
             have "t \<frown> u"
               using Con T U T' Con_rec(2) by blast
             moreover have 2: "T' \<^sup>*\<frown>\<^sup>* [u \\ t]"
               using Con T U T' Con_rec(2) by blast
             moreover have "[t \\ u] \<^sup>*\<frown>\<^sup>* U"
               using Con T U T'
               by (metis Con_initial_left Resid_rec(2))
             moreover have "T' \<^sup>*\\\<^sup>* [u \\ t] \<^sup>*\<frown>\<^sup>* U \<^sup>*\\\<^sup>* [t \\ u]"
             proof -
               have 0: "length (U \<^sup>*\\\<^sup>* [t \\ u]) = length U"
                 using Con T U T' length_Resid Con_sym calculation(3) by blast
               hence 1: "length T' + length (U \<^sup>*\\\<^sup>* [t \\ u]) \<le> n"
                 using Con T U T' len length_Resid Con_sym by simp
               have "length ((T \<^sup>*\\\<^sup>* [u]) \<^sup>*\\\<^sup>* U) =
                     length ([t \\ u] \<^sup>*\\\<^sup>* U) + length ((T' \<^sup>*\\\<^sup>* [u \\ t]) \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* [t \\ u]))"
               proof -
                 have "(T \<^sup>*\\\<^sup>* [u]) \<^sup>*\\\<^sup>* U =
                       [t \\ u] \<^sup>*\\\<^sup>* U @ (T' \<^sup>*\\\<^sup>* [u \\ t]) \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* [t \\ u])"
                   by (metis 0 1 2 Con Resid_rec(2) T T' U ind length_Resid)
                 thus ?thesis
                   using Con T U T' length_Resid by simp
               qed
               moreover have "length ((T \<^sup>*\\\<^sup>* [u]) \<^sup>*\\\<^sup>* U) = length T"
                 using Con T U T' length_Resid by metis
               moreover have "length ([t \\ u] \<^sup>*\\\<^sup>* U) \<le> 1"
                 using Con T U T' Resid1x_as_Resid
                 by (metis One_nat_def length_Cons list.size(3) order_refl zero_le)
               ultimately show ?thesis
                 using Con T U T' length_Resid by auto
             qed
             ultimately show "T \<^sup>*\<frown>\<^sup>* u # U"
               using T Con_rec(4) [of T' U t u] by fastforce
           qed
         qed
       qed
     qed
 
     text \<open>
       The following are the final versions of recursive expansion for consistency
       and residuation on paths.  These are what I really wanted the original definitions
       to look like, but if this is tried, then \<open>Con\<close> and \<open>Resid\<close> end up having to be mutually
       recursive, expressing the definitions so that they are single-valued becomes an issue,
       and proving termination is more problematic.
     \<close>
 
     lemma Con_cons:
     assumes "T \<noteq> []" and "U \<noteq> []"
     shows "t # T \<^sup>*\<frown>\<^sup>* U \<longleftrightarrow> [t] \<^sup>*\<frown>\<^sup>* U \<and> T \<^sup>*\<frown>\<^sup>* U \<^sup>*\\\<^sup>* [t]"
     and "T \<^sup>*\<frown>\<^sup>* u # U \<longleftrightarrow> T \<^sup>*\<frown>\<^sup>* [u] \<and> T \<^sup>*\\\<^sup>* [u] \<^sup>*\<frown>\<^sup>* U"
       using assms Resid_cons_ind [of T U] by blast+
 
     lemma Con_consI [intro, simp]:
     shows "\<lbrakk>T \<noteq> []; U \<noteq> []; [t] \<^sup>*\<frown>\<^sup>* U; T \<^sup>*\<frown>\<^sup>* U \<^sup>*\\\<^sup>* [t]\<rbrakk> \<Longrightarrow> t # T \<^sup>*\<frown>\<^sup>* U"
     and "\<lbrakk>T \<noteq> []; U \<noteq> []; T \<^sup>*\<frown>\<^sup>* [u]; T \<^sup>*\\\<^sup>* [u] \<^sup>*\<frown>\<^sup>* U\<rbrakk> \<Longrightarrow> T \<^sup>*\<frown>\<^sup>* u # U"
       using Con_cons by auto
 
     (* TODO: Making this a simp currently seems to produce undesirable breakage. *)
     lemma Resid_cons:
     assumes "U \<noteq> []"
     shows "t # T \<^sup>*\<frown>\<^sup>* U \<Longrightarrow> (t # T) \<^sup>*\\\<^sup>* U = ([t] \<^sup>*\\\<^sup>* U) @ (T \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* [t]))"
     and "T \<^sup>*\<frown>\<^sup>* u # U \<Longrightarrow> T \<^sup>*\\\<^sup>* (u # U) = (T \<^sup>*\\\<^sup>* [u]) \<^sup>*\\\<^sup>* U"
       using assms Resid_cons_ind [of T U] Resid.simps(1)
       by blast+
 
     text \<open>
       The following expansion of residuation with respect to the first argument
       is stated in terms of the more primitive cons, rather than list append,
       but as a result \<open>\<^sup>1\\<^sup>*\<close> has to be used.
     \<close>
 
     (* TODO: Making this a simp seems to produce similar breakage as above. *)
     lemma Resid_cons':
     assumes "T \<noteq> []"
     shows "t # T \<^sup>*\<frown>\<^sup>* U \<Longrightarrow> (t # T) \<^sup>*\\\<^sup>* U = (t \<^sup>1\\\<^sup>* U) # (T \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* [t]))"
       using assms
       by (metis Con_sym Resid.simps(1) Resid1x_as_Resid Resid_cons(1)
           append_Cons append_Nil)
 
     lemma Srcs_Resid_Arr_single:
     assumes "T \<^sup>*\<frown>\<^sup>* [u]"
     shows "Srcs (T \<^sup>*\\\<^sup>* [u]) = R.targets u"
     proof (cases T)
       show "T = [] \<Longrightarrow> Srcs (T \<^sup>*\\\<^sup>* [u]) = R.targets u"
         using assms by simp
       fix t T'
       assume T: "T = t # T'"
       show "Srcs (T \<^sup>*\\\<^sup>* [u]) = R.targets u"
       proof (cases "T' = []")
         show "T' = [] \<Longrightarrow> ?thesis"
           using assms T R.sources_resid by auto
         assume T': "T' \<noteq> []"
         have "Srcs (T \<^sup>*\\\<^sup>* [u]) = Srcs ((t # T') \<^sup>*\\\<^sup>* [u])"
           using T by simp
         also have "... = Srcs ((t \\ u) # (T' \<^sup>*\\\<^sup>* ([u] \<^sup>*\\\<^sup>* T')))"
           using assms T
           by (metis Resid_rec(2) Srcs.elims T' list.distinct(1) list.sel(1))
         also have "... = R.sources (t \\ u)"
           using Srcs.elims by blast
         also have "... = R.targets u"
           using assms Con_rec(2) T T' R.sources_resid by force
         finally show ?thesis by blast
       qed
     qed
 
     lemma Srcs_Resid_single_Arr:
-    shows "\<And>u. [u] \<^sup>*\<frown>\<^sup>* T \<Longrightarrow> Srcs ([u] \<^sup>*\\\<^sup>* T) = Trgs T"
-    proof (induct T)
+    shows "[u] \<^sup>*\<frown>\<^sup>* T \<Longrightarrow> Srcs ([u] \<^sup>*\\\<^sup>* T) = Trgs T"
+    proof (induct T arbitrary: u)
       show "\<And>u. [u] \<^sup>*\<frown>\<^sup>* [] \<Longrightarrow> Srcs ([u] \<^sup>*\\\<^sup>* []) = Trgs []"
         by simp
       fix t u T
       assume ind: "\<And>u. [u] \<^sup>*\<frown>\<^sup>* T  \<Longrightarrow> Srcs ([u] \<^sup>*\\\<^sup>* T) = Trgs T"
       assume Con: "[u] \<^sup>*\<frown>\<^sup>* t # T"
       show "Srcs ([u] \<^sup>*\\\<^sup>* (t # T)) = Trgs (t # T)"
       proof (cases "T = []")
         show "T = [] \<Longrightarrow> ?thesis"
           using Con Srcs_Resid_Arr_single Trgs.simps(2) by presburger
         assume T: "T \<noteq> []"
         have "Srcs ([u] \<^sup>*\\\<^sup>* (t # T)) = Srcs ([u \\ t] \<^sup>*\\\<^sup>* T)"
           using Con Resid_rec(3) T by force
         also have "... = Trgs T"
           using Con ind Con_rec(3) T by auto
         also have "... = Trgs (t # T)"
           by (metis T Trgs.elims Trgs.simps(3))
         finally show ?thesis by simp
       qed
     qed
 
     lemma Trgs_Resid_sym_Arr_single:
-    shows "\<And>u. T \<^sup>*\<frown>\<^sup>* [u] \<Longrightarrow> Trgs (T \<^sup>*\\\<^sup>* [u]) = Trgs ([u] \<^sup>*\\\<^sup>* T)"
-    proof (induct T)
+    shows "T \<^sup>*\<frown>\<^sup>* [u] \<Longrightarrow> Trgs (T \<^sup>*\\\<^sup>* [u]) = Trgs ([u] \<^sup>*\\\<^sup>* T)"
+    proof (induct T arbitrary: u)
       show "\<And>u. [] \<^sup>*\<frown>\<^sup>* [u] \<Longrightarrow> Trgs ([] \<^sup>*\\\<^sup>* [u]) = Trgs ([u] \<^sup>*\\\<^sup>* [])"
         by simp
       fix t u T
       assume ind: "\<And>u. T \<^sup>*\<frown>\<^sup>* [u] \<Longrightarrow> Trgs (T \<^sup>*\\\<^sup>* [u]) = Trgs ([u] \<^sup>*\\\<^sup>* T)"
       assume Con: "t # T \<^sup>*\<frown>\<^sup>* [u]"
       show "Trgs ((t # T) \<^sup>*\\\<^sup>* [u]) = Trgs ([u] \<^sup>*\\\<^sup>* (t # T))"
       proof (cases "T = []")
         show "T = [] \<Longrightarrow> ?thesis"
           using R.targets_resid_sym
           by (simp add: R.con_sym)
         assume T: "T \<noteq> []"
         show ?thesis
         proof -
           have "Trgs ((t # T) \<^sup>*\\\<^sup>* [u]) = Trgs ((t \\ u) # (T \<^sup>*\\\<^sup>* [u \\ t]))"
             using Con Resid_rec(2) T by auto
           also have "... = Trgs (T \<^sup>*\\\<^sup>* [u \\ t])"
             using T Con Con_rec(2) [of T t u]
             by (metis Trgs.elims Trgs.simps(3))
           also have "... = Trgs ([u \\ t] \<^sup>*\\\<^sup>* T)"
             using T Con ind Con_sym by metis
           also have "... = Trgs ([u] \<^sup>*\\\<^sup>* (t # T))"
             using T Con Con_sym Resid_rec(3) by presburger
           finally show ?thesis by blast
         qed
       qed
     qed
 
     lemma Srcs_Resid [simp]:
-    shows "\<And>T. T \<^sup>*\<frown>\<^sup>* U \<Longrightarrow> Srcs (T \<^sup>*\\\<^sup>* U) = Trgs U"
-    proof (induct U)
+    shows "T \<^sup>*\<frown>\<^sup>* U \<Longrightarrow> Srcs (T \<^sup>*\\\<^sup>* U) = Trgs U"
+    proof (induct U arbitrary: T)
       show "\<And>T. T \<^sup>*\<frown>\<^sup>* [] \<Longrightarrow> Srcs (T \<^sup>*\\\<^sup>* []) = Trgs []"
         using Con_sym Resid.simps(1) by blast
       fix u U T
       assume ind: "\<And>T. T \<^sup>*\<frown>\<^sup>* U \<Longrightarrow> Srcs (T \<^sup>*\\\<^sup>* U) = Trgs U"
       assume Con: "T \<^sup>*\<frown>\<^sup>* u # U"
       show "Srcs (T \<^sup>*\\\<^sup>* (u # U)) = Trgs (u # U)"
         by (metis Con Resid_cons(2) Srcs_Resid_Arr_single Trgs.simps(2-3) ind
             list.exhaust_sel)
     qed
 
     lemma Trgs_Resid_sym [simp]:
-    shows "\<And>T. T \<^sup>*\<frown>\<^sup>* U \<Longrightarrow> Trgs (T \<^sup>*\\\<^sup>* U) = Trgs (U \<^sup>*\\\<^sup>* T)"
-    proof (induct U)
+    shows "T \<^sup>*\<frown>\<^sup>* U \<Longrightarrow> Trgs (T \<^sup>*\\\<^sup>* U) = Trgs (U \<^sup>*\\\<^sup>* T)"
+    proof (induct U arbitrary: T)
       show "\<And>T. T \<^sup>*\<frown>\<^sup>* [] \<Longrightarrow> Trgs (T \<^sup>*\\\<^sup>* []) = Trgs ([] \<^sup>*\\\<^sup>* T)"
         by (meson Con_sym Resid.simps(1))
       fix u U T
       assume ind: "\<And>T. T \<^sup>*\<frown>\<^sup>* U \<Longrightarrow> Trgs (T \<^sup>*\\\<^sup>* U) = Trgs (U \<^sup>*\\\<^sup>* T)"
       assume Con: "T \<^sup>*\<frown>\<^sup>* u # U"
       show "Trgs (T \<^sup>*\\\<^sup>* (u # U)) = Trgs ((u # U) \<^sup>*\\\<^sup>* T)"
       proof (cases "U = []")
         show "U = [] \<Longrightarrow> ?thesis"
           using Con Trgs_Resid_sym_Arr_single by blast
         assume U: "U \<noteq> []"
         show ?thesis
         proof -
           have "Trgs (T \<^sup>*\\\<^sup>* (u # U)) = Trgs ((T \<^sup>*\\\<^sup>* [u]) \<^sup>*\\\<^sup>* U)"
             using U by (metis Con Resid_cons(2))
           also have "... = Trgs (U \<^sup>*\\\<^sup>* (T \<^sup>*\\\<^sup>* [u]))"
             using U Con by (metis Con_sym ind)
           also have "... = Trgs ((u # U) \<^sup>*\\\<^sup>* T)"
             by (metis (no_types, opaque_lifting) Con_cons(1) Con_sym Resid.simps(1) Resid_cons'
                 Trgs.simps(3) U neq_Nil_conv)
           finally show ?thesis by simp
         qed
       qed
     qed
 
     lemma img_Resid_Srcs:
     shows "Arr T \<Longrightarrow> (\<lambda>a. [a] \<^sup>*\\\<^sup>* T) ` Srcs T \<subseteq> (\<lambda>b. [b]) ` Trgs T"
     proof (induct T)
       show "Arr [] \<Longrightarrow> (\<lambda>a. [a] \<^sup>*\\\<^sup>* []) ` Srcs [] \<subseteq> (\<lambda>b. [b]) ` Trgs []"
         by simp
       fix t :: 'a and T :: "'a list"
       assume tT: "Arr (t # T)"
       assume ind: "Arr T \<Longrightarrow> (\<lambda>a. [a] \<^sup>*\\\<^sup>* T) ` Srcs T \<subseteq> (\<lambda>b. [b]) ` Trgs T"
       show "(\<lambda>a. [a] \<^sup>*\\\<^sup>* (t # T)) ` Srcs (t # T) \<subseteq> (\<lambda>b. [b]) ` Trgs (t # T)"
       proof
         fix B
         assume B: "B \<in> (\<lambda>a. [a] \<^sup>*\\\<^sup>* (t # T)) ` Srcs (t # T)"
         show "B \<in> (\<lambda>b. [b]) ` Trgs (t # T)"
         proof (cases "T = []")
           assume T: "T = []"
           obtain a where a: "a \<in> R.sources t \<and> [a \\ t] = B"
             by (metis (no_types, lifting) B R.composite_of_source_arr R.con_prfx_composite_of(1)
                 Resid_rec(1) Srcs.simps(2) T Arr.simps(2) Con_rec(1) imageE tT)
           have "a \\ t \<in> Trgs (t # T)"
             using tT T a
             by (simp add: R.resid_source_in_targets)
           thus ?thesis
             using B a image_iff by fastforce
           next
           assume T: "T \<noteq> []"
           obtain a where a: "a \<in> R.sources t \<and> [a] \<^sup>*\\\<^sup>* (t # T) = B"
             using tT T B Srcs.elims by blast
           have "[a \\ t] \<^sup>*\\\<^sup>* T = B"
             using tT T B a
             by (metis Con_rec(3) R.arrI R.resid_source_in_targets R.targets_are_cong
                 Resid_rec(3) R.arr_resid_iff_con R.ide_implies_arr)
           moreover have "a \\ t \<in> Srcs T"
             using a tT
             by (metis Arr.simps(3) R.resid_source_in_targets T neq_Nil_conv subsetD)
           ultimately show ?thesis
             using T tT ind
             by (metis Trgs.simps(3) Arr.simps(3) image_iff list.exhaust_sel subsetD)
         qed
       qed
     qed
 
     lemma Resid_Arr_Src:
-    shows "\<And>a. \<lbrakk>Arr T; a \<in> Srcs T\<rbrakk> \<Longrightarrow> T \<^sup>*\\\<^sup>* [a] = T"
-    proof (induct T)
+    shows "\<lbrakk>Arr T; a \<in> Srcs T\<rbrakk> \<Longrightarrow> T \<^sup>*\\\<^sup>* [a] = T"
+    proof (induct T arbitrary: a)
       show "\<And>a. \<lbrakk>Arr []; a \<in> Srcs []\<rbrakk> \<Longrightarrow> [] \<^sup>*\\\<^sup>* [a] = []"
         by simp
       fix a t T
       assume ind: "\<And>a. \<lbrakk>Arr T; a \<in> Srcs T\<rbrakk> \<Longrightarrow> T \<^sup>*\\\<^sup>* [a] = T"
       assume Arr: "Arr (t # T)"
       assume a: "a \<in> Srcs (t # T)"
       show "(t # T) \<^sup>*\\\<^sup>* [a] = t # T"
       proof (cases "T = []")
         show "T = [] \<Longrightarrow> ?thesis"
           using a R.resid_arr_ide R.sources_def by auto
         assume T: "T \<noteq> []"
         show "(t # T) \<^sup>*\\\<^sup>* [a] = t # T"
         proof -
           have 1: "R.arr t \<and> Arr T \<and> R.targets t \<subseteq> Srcs T"
             using Arr T
             by (metis Arr.elims(2) list.sel(1) list.sel(3))
           have 2: "t # T \<^sup>*\<frown>\<^sup>* [a]"
             using T a Arr Con_rec(2)
             by (metis (no_types, lifting) img_Resid_Srcs Con_sym imageE image_subset_iff
                 list.distinct(1))
           have "(t # T) \<^sup>*\\\<^sup>* [a] = (t \\ a) # (T \<^sup>*\\\<^sup>* [a \\ t])"
             using 2 T Resid_rec(2) by simp
           moreover have "t \\ a = t"
             using Arr a R.sources_def
             by (metis "2" CollectD Con_rec(2) T Srcs_are_ide in_mono R.resid_arr_ide)
           moreover have "T \<^sup>*\\\<^sup>* [a \\ t] = T"
             by (metis "1" "2" R.in_sourcesI R.resid_source_in_targets Srcs_are_ide T a
                       Con_rec(2) in_mono ind mem_Collect_eq)
           ultimately show ?thesis by simp
         qed
       qed
     qed
 
     lemma Con_single_ide_ind:
-    shows "\<And>a. R.ide a \<Longrightarrow> [a] \<^sup>*\<frown>\<^sup>* T \<longleftrightarrow> Arr T \<and> a \<in> Srcs T"
-    proof (induct T)
+    shows "R.ide a \<Longrightarrow> [a] \<^sup>*\<frown>\<^sup>* T \<longleftrightarrow> Arr T \<and> a \<in> Srcs T"
+    proof (induct T arbitrary: a)
       show "\<And>a. [a] \<^sup>*\<frown>\<^sup>* [] \<longleftrightarrow> Arr [] \<and> a \<in> Srcs []"
         by simp
       fix a t T
       assume ind: "\<And>a. R.ide a \<Longrightarrow> [a] \<^sup>*\<frown>\<^sup>* T \<longleftrightarrow> Arr T \<and> a \<in> Srcs T"
       assume a: "R.ide a"
       show "[a] \<^sup>*\<frown>\<^sup>* (t # T) \<longleftrightarrow> Arr (t # T) \<and> a \<in> Srcs (t # T)"
       proof (cases "T = []")
         show "T = [] \<Longrightarrow> ?thesis"
           using a Con_sym
           by (metis Arr.simps(2) Resid_Arr_Src Srcs.simps(2) R.arr_iff_has_source
               Con_rec(1) empty_iff R.in_sourcesI list.distinct(1))
         assume T: "T \<noteq> []"
         have 1: "[a] \<^sup>*\<frown>\<^sup>* (t # T) \<longleftrightarrow> a \<frown> t \<and> [a \\ t] \<^sup>*\<frown>\<^sup>* T"
           using a T Con_cons(2) [of "[a]" T t] by simp
         also have 2: "... \<longleftrightarrow> a \<frown> t \<and> Arr T \<and> a \\ t \<in> Srcs T"
           using a T ind R.resid_ide_arr by blast
         also have "... \<longleftrightarrow> Arr (t # T) \<and> a \<in> Srcs (t # T)"
           using a T Con_sym R.con_sym Resid_Arr_Src R.con_implies_arr Srcs_are_ide
           apply (cases T)
            apply simp
           by (metis Arr.simps(3) R.resid_arr_ide R.targets_resid_sym Srcs.simps(3)
               Srcs_Resid_Arr_single calculation dual_order.eq_iff list.distinct(1)
               R.in_sourcesI)
         finally show ?thesis by simp
       qed
     qed
 
     lemma Con_single_ide_iff:
     assumes "R.ide a"
     shows "[a] \<^sup>*\<frown>\<^sup>* T \<longleftrightarrow> Arr T \<and> a \<in> Srcs T"
       using assms Con_single_ide_ind by simp
 
     lemma Con_single_ideI [intro]:
     assumes "R.ide a" and "Arr T" and "a \<in> Srcs T"
     shows "[a] \<^sup>*\<frown>\<^sup>* T" and "T \<^sup>*\<frown>\<^sup>* [a]"
       using assms Con_single_ide_iff Con_sym by auto
 
     lemma Resid_single_ide:
     assumes "R.ide a" and "[a] \<^sup>*\<frown>\<^sup>* T"
     shows "[a] \<^sup>*\\\<^sup>* T \<in> (\<lambda>b. [b]) ` Trgs T" and [simp]: "T \<^sup>*\\\<^sup>* [a] = T"
       using assms Con_single_ide_ind img_Resid_Srcs Resid_Arr_Src Con_sym
       by blast+
 
     lemma Resid_Arr_Ide_ind:
     shows "\<lbrakk>Ide A; T \<^sup>*\<frown>\<^sup>* A\<rbrakk> \<Longrightarrow> T \<^sup>*\\\<^sup>* A = T"
     proof (induct A)
       show "\<lbrakk>Ide []; T \<^sup>*\<frown>\<^sup>* []\<rbrakk> \<Longrightarrow> T \<^sup>*\\\<^sup>* [] = T"
         by simp
       fix a A
       assume ind: "\<lbrakk>Ide A; T \<^sup>*\<frown>\<^sup>* A\<rbrakk> \<Longrightarrow> T \<^sup>*\\\<^sup>* A = T"
       assume Ide: "Ide (a # A)"
       assume Con: "T \<^sup>*\<frown>\<^sup>* a # A"
       show "T \<^sup>*\\\<^sup>* (a # A) = T"
         by (metis (no_types, lifting) Con Con_initial_left Con_sym Ide Ide.elims(2)
             Resid_cons(2) Resid_single_ide(2) ind list.inject)
     qed
 
     lemma Resid_Ide_Arr_ind:
     shows "\<lbrakk>Ide A; A \<^sup>*\<frown>\<^sup>* T\<rbrakk> \<Longrightarrow> Ide (A \<^sup>*\\\<^sup>* T)"
     proof (induct A)
       show "\<lbrakk>Ide []; [] \<^sup>*\<frown>\<^sup>* T\<rbrakk> \<Longrightarrow> Ide ([] \<^sup>*\\\<^sup>* T)"
         by simp
       fix a A
       assume ind: "\<lbrakk>Ide A; A \<^sup>*\<frown>\<^sup>* T\<rbrakk> \<Longrightarrow> Ide (A \<^sup>*\\\<^sup>* T)"
       assume Ide: "Ide (a # A)"
       assume Con: "a # A \<^sup>*\<frown>\<^sup>* T"
       have T: "Arr T"
         using Con Ide Con_single_ide_ind Con_initial_left Ide.elims(2)
         by blast
       show "Ide ((a # A) \<^sup>*\\\<^sup>* T)"
       proof (cases "A = []")
         show "A = [] \<Longrightarrow> ?thesis"
           by (metis Con Con_sym1 Ide Ide.simps(2) Resid1x_as_Resid Resid1x_ide
               Residx1_as_Resid Con_sym)
         assume A: "A \<noteq> []"
         show ?thesis
         proof -
           have "Ide ([a] \<^sup>*\\\<^sup>* T)"
             by (metis Con Con_initial_left Con_sym Con_sym1 Ide Ide.simps(3)
                 Resid1x_as_Resid Residx1_as_Resid Ide.simps(2) Resid1x_ide
                 list.exhaust_sel)
           moreover have "Trgs ([a] \<^sup>*\\\<^sup>* T) \<subseteq> Srcs (A \<^sup>*\\\<^sup>* T)"
             using A T Ide Con
             by (metis (no_types, lifting) Con_sym Ide.elims(2) Ide.simps(2) Resid_Arr_Ide_ind
                 Srcs_Resid Trgs_Resid_sym Con_cons(2) dual_order.eq_iff list.inject)
           moreover have "Ide (A \<^sup>*\\\<^sup>* (T \<^sup>*\\\<^sup>* [a]))"
             by (metis A Con Con_cons(1) Con_sym Ide Ide.simps(3) Resid_Arr_Ide_ind
                 Resid_single_ide(2) ind list.exhaust_sel)
           moreover have "Ide ((a # A) \<^sup>*\\\<^sup>* T) \<longleftrightarrow> 
                          Ide ([a] \<^sup>*\\\<^sup>* T) \<and> Ide (A \<^sup>*\\\<^sup>* (T \<^sup>*\\\<^sup>* [a])) \<and>
                            Trgs ([a] \<^sup>*\\\<^sup>* T) \<subseteq> Srcs (A \<^sup>*\\\<^sup>* T)"
             using calculation(1-3)
             by (metis Arr.simps(1) Con Ide Ide.simps(3) Resid1x_as_Resid Resid_cons'
                Trgs.simps(2) Con_single_ide_iff Ide.simps(2) Ide_implies_Arr Resid_Arr_Src
                 list.exhaust_sel)
           ultimately show ?thesis by blast
         qed
       qed
     qed
 
     lemma Resid_Ide:
     assumes "Ide A" and "A \<^sup>*\<frown>\<^sup>* T"
     shows "T \<^sup>*\\\<^sup>* A = T" and "Ide (A \<^sup>*\\\<^sup>* T)"
       using assms Resid_Ide_Arr_ind Resid_Arr_Ide_ind Con_sym by auto
 
     lemma Con_Ide_iff:
     shows "Ide A \<Longrightarrow> A \<^sup>*\<frown>\<^sup>* T \<longleftrightarrow> Arr T \<and> Srcs T = Srcs A"
     proof (induct A)
       show "Ide [] \<Longrightarrow> [] \<^sup>*\<frown>\<^sup>* T \<longleftrightarrow> Arr T \<and> Srcs T = Srcs []"
         by simp
       fix a A
       assume ind: "Ide A \<Longrightarrow> A \<^sup>*\<frown>\<^sup>* T \<longleftrightarrow> Arr T \<and> Srcs T = Srcs A"
       assume Ide: "Ide (a # A)"
       show "a # A \<^sup>*\<frown>\<^sup>* T \<longleftrightarrow> Arr T \<and> Srcs T = Srcs (a # A)"
       proof (cases "A = []")
         show "A = [] \<Longrightarrow> ?thesis"
           using Con_single_ide_ind Ide
           by (metis Arr.simps(2) Con_sym Ide.simps(2) Ide_implies_Arr R.arrE
                     Resid_Arr_Src Srcs.simps(2) Srcs_Resid R.in_sourcesI)
         assume A: "A \<noteq> []"
         have "a # A \<^sup>*\<frown>\<^sup>* T \<longleftrightarrow> [a] \<^sup>*\<frown>\<^sup>* T \<and> A \<^sup>*\<frown>\<^sup>* T \<^sup>*\\\<^sup>* [a]"
           using A Ide Con_cons(1) [of A T a] by fastforce
         also have 1: "... \<longleftrightarrow> Arr T \<and> a \<in> Srcs T"
           by (metis A Arr_has_Src Con_single_ide_ind Ide Ide.elims(2) Resid_Arr_Src
               Srcs_Resid_Arr_single Con_sym Srcs_eqI ind inf.absorb_iff2 list.inject)
         also have "... \<longleftrightarrow> Arr T \<and> Srcs T = Srcs (a # A)"
           by (metis A 1 Con_sym Ide Ide.simps(3) R.ideE
               R.sources_resid Resid_Arr_Src Srcs.simps(3) Srcs_Resid_Arr_single
               list.exhaust_sel R.in_sourcesI)
         finally show "a # A \<^sup>*\<frown>\<^sup>* T \<longleftrightarrow> Arr T \<and> Srcs T = Srcs (a # A)"
           by blast
       qed
     qed
 
     lemma Con_IdeI:
     assumes "Ide A" and "Arr T" and "Srcs T = Srcs A"
     shows "A \<^sup>*\<frown>\<^sup>* T" and "T \<^sup>*\<frown>\<^sup>* A"
       using assms Con_Ide_iff Con_sym by auto
 
     lemma Con_Arr_self:
     shows "Arr T \<Longrightarrow> T \<^sup>*\<frown>\<^sup>* T"
     proof (induct T)
       show "Arr [] \<Longrightarrow> [] \<^sup>*\<frown>\<^sup>* []"
         by simp
       fix t T
       assume ind: "Arr T \<Longrightarrow> T \<^sup>*\<frown>\<^sup>* T"
       assume Arr: "Arr (t # T)"
       show "t # T \<^sup>*\<frown>\<^sup>* t # T"
       proof (cases "T = []")
         show "T = [] \<Longrightarrow> ?thesis"
           using Arr R.arrE by simp
         assume T: "T \<noteq> []"
         have "t \<frown> t \<and> T \<^sup>*\<frown>\<^sup>* [t \\ t] \<and> [t \\ t] \<^sup>*\<frown>\<^sup>* T \<and> T \<^sup>*\\\<^sup>* [t \\ t] \<^sup>*\<frown>\<^sup>* T \<^sup>*\\\<^sup>* [t \\ t]"
         proof -
           have "t \<frown> t"
             using Arr Arr.elims(1) by auto
           moreover have "T \<^sup>*\<frown>\<^sup>* [t \\ t]"
           proof -
             have "Ide [t \\ t]"
               by (simp add: R.arr_def R.prfx_reflexive calculation)
             moreover have "Srcs [t \\ t] = Srcs T"
               by (metis Arr Arr.simps(2) Arr_has_Trg R.arrE R.sources_resid Srcs.simps(2)
                   Srcs_eqI T Trgs.simps(2) Arr.simps(3) inf.absorb_iff2 list.exhaust)
             ultimately show ?thesis
               by (metis Arr Con_sym T Arr.simps(3) Con_Ide_iff neq_Nil_conv)
           qed
           ultimately show ?thesis
             by (metis Con_single_ide_ind Con_sym R.prfx_reflexive
                 Resid_single_ide(2) ind R.con_implies_arr(1))
         qed
         thus ?thesis
           using Con_rec(4) [of T T t t] by force
       qed
     qed
 
     lemma Resid_Arr_self:
     shows "Arr T \<Longrightarrow> Ide (T \<^sup>*\\\<^sup>* T)"
     proof (induct T)
       show "Arr [] \<Longrightarrow> Ide ([] \<^sup>*\\\<^sup>* [])"
         by simp
       fix t T
       assume ind: "Arr T \<Longrightarrow> Ide (T \<^sup>*\\\<^sup>* T)"
       assume Arr: "Arr (t # T)"
       show "Ide ((t # T) \<^sup>*\\\<^sup>* (t # T))"
       proof (cases "T = []")
         show "T = [] \<Longrightarrow> ?thesis"
           using Arr R.prfx_reflexive by auto
         assume T: "T \<noteq> []"
         have 1: "(t # T) \<^sup>*\\\<^sup>* (t # T) = t \<^sup>1\\\<^sup>* (t # T) # T \<^sup>*\\\<^sup>* ((t # T) \<^sup>*\\\<^sup>* [t])"
           using Arr T Resid_cons' [of T t "t # T"] Con_Arr_self by presburger
         also have "... = (t \\ t) \<^sup>1\\\<^sup>* T # T \<^sup>*\\\<^sup>* (t \<^sup>1\\\<^sup>* [t] # T \<^sup>*\\\<^sup>* ([t] \<^sup>*\\\<^sup>* [t]))"
           using Arr T Resid_cons' [of T t "[t]"]
           by (metis Con_initial_right Resid1x.simps(3) calculation neq_Nil_conv)
         also have "... = (t \\ t) \<^sup>1\\\<^sup>* T # (T \<^sup>*\\\<^sup>* ([t] \<^sup>*\\\<^sup>* [t])) \<^sup>*\\\<^sup>* (T \<^sup>*\\\<^sup>* ([t] \<^sup>*\\\<^sup>* [t]))"
           by (metis 1 Resid1x.simps(2) Residx1.simps(2) Residx1_as_Resid T calculation
               Con_cons(1) Con_rec(4) Resid_cons(2) list.distinct(1) list.inject)
         finally have 2: "(t # T) \<^sup>*\\\<^sup>* (t # T) =
                          (t \\ t) \<^sup>1\\\<^sup>* T # (T \<^sup>*\\\<^sup>* ([t] \<^sup>*\\\<^sup>* [t])) \<^sup>*\\\<^sup>* (T \<^sup>*\\\<^sup>* ([t] \<^sup>*\\\<^sup>* [t]))"
           by blast
         moreover have "Ide ..."
         proof -
           have "R.ide ((t \\ t) \<^sup>1\\\<^sup>* T)"
             using Arr T
             by (metis Con_initial_right Con_rec(2) Con_sym1 R.con_implies_arr(1)
                 Resid1x_ide Con_Arr_self Residx1_as_Resid R.prfx_reflexive)
           moreover have "Ide ((T \<^sup>*\\\<^sup>* ([t] \<^sup>*\\\<^sup>* [t])) \<^sup>*\\\<^sup>* (T \<^sup>*\\\<^sup>* ([t] \<^sup>*\\\<^sup>* [t])))"
             using Arr T
             by (metis Con_Arr_self Con_rec(4) Resid_single_ide(2) Con_single_ide_ind
                 Resid.simps(3) ind R.prfx_reflexive R.con_implies_arr(2))
           moreover have "R.targets ((t \\ t) \<^sup>1\\\<^sup>* T) \<subseteq>
                            Srcs ((T \<^sup>*\\\<^sup>* ([t] \<^sup>*\\\<^sup>* [t])) \<^sup>*\\\<^sup>* (T \<^sup>*\\\<^sup>* ([t] \<^sup>*\\\<^sup>* [t])))"
             by (metis (no_types, lifting) 1 2 Con_cons(1) Resid1x_as_Resid T Trgs.simps(2)
                 Trgs_Resid_sym Srcs_Resid dual_order.eq_iff list.discI list.inject)
           ultimately show ?thesis
             using Arr T
             by (metis Ide.simps(1,3) list.exhaust_sel)
         qed
         ultimately show ?thesis by auto
       qed
     qed
 
     lemma Con_imp_eq_Srcs:
     assumes "T \<^sup>*\<frown>\<^sup>* U"
     shows "Srcs T = Srcs U"
     proof (cases T)
       show "T = [] \<Longrightarrow> ?thesis"
         using assms by simp
       fix t T'
       assume T: "T = t # T'"
       show "Srcs T = Srcs U"
       proof (cases U)
         show "U = [] \<Longrightarrow> ?thesis"
           using assms T by simp
         fix u U'
         assume U: "U = u # U'"
         show "Srcs T = Srcs U"
           by (metis Con_initial_right Con_rec(1) Con_sym R.con_imp_common_source
               Srcs.simps(2-3) Srcs_eqI T Trgs.cases U assms)
       qed
     qed
 
     lemma Arr_iff_Con_self:
     shows "Arr T \<longleftrightarrow> T \<^sup>*\<frown>\<^sup>* T"
     proof (induct T)
       show "Arr [] \<longleftrightarrow> [] \<^sup>*\<frown>\<^sup>* []"
         by simp
       fix t T
       assume ind: "Arr T \<longleftrightarrow> T \<^sup>*\<frown>\<^sup>* T"
       show "Arr (t # T) \<longleftrightarrow> t # T \<^sup>*\<frown>\<^sup>* t # T"
       proof (cases "T = []")
         show "T = [] \<Longrightarrow> ?thesis"
           by auto
         assume T: "T \<noteq> []"
         show ?thesis
         proof
           show "Arr (t # T) \<Longrightarrow> t # T \<^sup>*\<frown>\<^sup>* t # T"
             using Con_Arr_self by simp
           show "t # T \<^sup>*\<frown>\<^sup>* t # T \<Longrightarrow> Arr (t # T)"
           proof -
             assume Con: "t # T \<^sup>*\<frown>\<^sup>* t # T"
             have "R.arr t"
               using T Con Con_rec(4) [of T T t t] by blast
             moreover have "Arr T"
               using T Con Con_rec(4) [of T T t t] ind R.arrI
               by (meson R.prfx_reflexive Con_single_ide_ind)
             moreover have "R.targets t \<subseteq> Srcs T"
               using T Con
               by (metis Con_cons(2) Con_imp_eq_Srcs Trgs.simps(2)
                   Srcs_Resid list.distinct(1) subsetI)
             ultimately show ?thesis
               by (cases T) auto
           qed
         qed
       qed
     qed
 
     lemma Arr_Resid_single:
-    shows "\<And>u. T \<^sup>*\<frown>\<^sup>* [u] \<Longrightarrow> Arr (T \<^sup>*\\\<^sup>* [u])"
-    proof (induct T)
+    shows "T \<^sup>*\<frown>\<^sup>* [u] \<Longrightarrow> Arr (T \<^sup>*\\\<^sup>* [u])"
+    proof (induct T arbitrary: u)
       show "\<And>u. [] \<^sup>*\<frown>\<^sup>* [u] \<Longrightarrow> Arr ([] \<^sup>*\\\<^sup>* [u])"
         by simp
       fix t u T
       assume ind: "\<And>u. T \<^sup>*\<frown>\<^sup>* [u] \<Longrightarrow> Arr (T \<^sup>*\\\<^sup>* [u])"
       assume Con: "t # T \<^sup>*\<frown>\<^sup>* [u]"
       show "Arr ((t # T) \<^sup>*\\\<^sup>* [u])"
       proof (cases "T = []")
         show "T = [] \<Longrightarrow> ?thesis"
           using Con Arr_iff_Con_self R.con_imp_arr_resid Con_rec(1) by fastforce
         assume T: "T \<noteq> []"
         have "Arr ((t # T) \<^sup>*\\\<^sup>* [u]) \<longleftrightarrow> Arr ((t \\ u) # (T \<^sup>*\\\<^sup>* [u \\ t]))"
           using Con T Resid_rec(2) by auto
         also have "... \<longleftrightarrow> R.arr (t \\ u) \<and> Arr (T \<^sup>*\\\<^sup>* [u \\ t]) \<and>
                            R.targets (t \\ u) \<subseteq> Srcs (T \<^sup>*\\\<^sup>* [u \\ t])"
           using Con T
           by (metis Arr.simps(3) Con_rec(2) neq_Nil_conv)
         also have "... \<longleftrightarrow> R.con t u \<and> Arr (T \<^sup>*\\\<^sup>* [u \\ t])"
           using Con T
           by (metis Srcs_Resid_Arr_single Con_rec(2) R.arr_resid_iff_con subsetI
               R.targets_resid_sym)
         also have "... \<longleftrightarrow> True"
           using Con ind T Con_rec(2) by blast
         finally show ?thesis by auto
       qed
     qed
 
     lemma Con_imp_Arr_Resid:
-    shows "\<And>T. T \<^sup>*\<frown>\<^sup>* U \<Longrightarrow> Arr (T \<^sup>*\\\<^sup>* U)"
-    proof (induct U)
+    shows "T \<^sup>*\<frown>\<^sup>* U \<Longrightarrow> Arr (T \<^sup>*\\\<^sup>* U)"
+    proof (induct U arbitrary: T)
       show "\<And>T. T \<^sup>*\<frown>\<^sup>* [] \<Longrightarrow> Arr (T \<^sup>*\\\<^sup>* [])"
         by (meson Con_sym Resid.simps(1))
       fix u U T
       assume ind: "\<And>T. T \<^sup>*\<frown>\<^sup>* U \<Longrightarrow> Arr (T \<^sup>*\\\<^sup>* U)"
       assume Con: "T \<^sup>*\<frown>\<^sup>* u # U"
       show "Arr (T \<^sup>*\\\<^sup>* (u # U))"
         by (metis Arr_Resid_single Con Resid_cons(2) ind)
     qed
 
     lemma Cube_ind:
-    shows "\<And>T U V. \<lbrakk>T \<^sup>*\<frown>\<^sup>* U; V \<^sup>*\<frown>\<^sup>* T; length T + length U + length V \<le> n\<rbrakk> \<Longrightarrow>
-                    (V \<^sup>*\\\<^sup>* T \<^sup>*\<frown>\<^sup>* U \<^sup>*\\\<^sup>* T \<longleftrightarrow> V \<^sup>*\\\<^sup>* U \<^sup>*\<frown>\<^sup>* T \<^sup>*\\\<^sup>* U) \<and>
-                    (V \<^sup>*\\\<^sup>* T \<^sup>*\<frown>\<^sup>* U \<^sup>*\\\<^sup>* T \<longrightarrow>
-                      (V \<^sup>*\\\<^sup>* T) \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* T) = (V \<^sup>*\\\<^sup>* U) \<^sup>*\\\<^sup>* (T \<^sup>*\\\<^sup>* U))"
-    proof (induct n)
+    shows "\<lbrakk>T \<^sup>*\<frown>\<^sup>* U; V \<^sup>*\<frown>\<^sup>* T; length T + length U + length V \<le> n\<rbrakk> \<Longrightarrow>
+             (V \<^sup>*\\\<^sup>* T \<^sup>*\<frown>\<^sup>* U \<^sup>*\\\<^sup>* T \<longleftrightarrow> V \<^sup>*\\\<^sup>* U \<^sup>*\<frown>\<^sup>* T \<^sup>*\\\<^sup>* U) \<and>
+             (V \<^sup>*\\\<^sup>* T \<^sup>*\<frown>\<^sup>* U \<^sup>*\\\<^sup>* T \<longrightarrow>
+               (V \<^sup>*\\\<^sup>* T) \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* T) = (V \<^sup>*\\\<^sup>* U) \<^sup>*\\\<^sup>* (T \<^sup>*\\\<^sup>* U))"
+    proof (induct n arbitrary: T U V)
       show "\<And>T U V. \<lbrakk>T \<^sup>*\<frown>\<^sup>* U; V \<^sup>*\<frown>\<^sup>* T; length T + length U + length V \<le> 0\<rbrakk> \<Longrightarrow>
                        (V \<^sup>*\\\<^sup>* T \<^sup>*\<frown>\<^sup>* U \<^sup>*\\\<^sup>* T \<longleftrightarrow> V \<^sup>*\\\<^sup>* U \<^sup>*\<frown>\<^sup>* T \<^sup>*\\\<^sup>* U) \<and>
                        (V \<^sup>*\\\<^sup>* T \<^sup>*\<frown>\<^sup>* U \<^sup>*\\\<^sup>* T \<longrightarrow>
                          (V \<^sup>*\\\<^sup>* T) \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* T) = (V \<^sup>*\\\<^sup>* U) \<^sup>*\\\<^sup>* (T \<^sup>*\\\<^sup>* U))"
         by simp
       fix n and T U V :: "'a list"
       assume Con_TU: "T \<^sup>*\<frown>\<^sup>* U" and Con_VT: "V \<^sup>*\<frown>\<^sup>* T"
       have T: "T \<noteq> []"
         using Con_TU by auto
       have U: "U \<noteq> []"
         using Con_TU Con_sym Resid.simps(1) by blast
       have V: "V \<noteq> []"
         using Con_VT by auto
       assume len: "length T + length U + length V \<le> Suc n"
       assume ind: "\<And>T U V. \<lbrakk>T \<^sup>*\<frown>\<^sup>* U; V \<^sup>*\<frown>\<^sup>* T; length T + length U + length V \<le> n\<rbrakk> \<Longrightarrow>
                             (V \<^sup>*\\\<^sup>* T \<^sup>*\<frown>\<^sup>* U \<^sup>*\\\<^sup>* T \<longleftrightarrow> V \<^sup>*\\\<^sup>* U \<^sup>*\<frown>\<^sup>* T \<^sup>*\\\<^sup>* U) \<and>
                             (V \<^sup>*\\\<^sup>* T \<^sup>*\<frown>\<^sup>* U \<^sup>*\\\<^sup>* T \<longrightarrow>
                               (V \<^sup>*\\\<^sup>* T) \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* T) = (V \<^sup>*\\\<^sup>* U) \<^sup>*\\\<^sup>* (T \<^sup>*\\\<^sup>* U))"
       show "(V \<^sup>*\\\<^sup>* T \<^sup>*\<frown>\<^sup>* U \<^sup>*\\\<^sup>* T \<longleftrightarrow> V \<^sup>*\\\<^sup>* U \<^sup>*\<frown>\<^sup>* T \<^sup>*\\\<^sup>* U) \<and>
             (V \<^sup>*\\\<^sup>* T \<^sup>*\<frown>\<^sup>* U \<^sup>*\\\<^sup>* T \<longrightarrow> (V \<^sup>*\\\<^sup>* T) \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* T) = (V \<^sup>*\\\<^sup>* U) \<^sup>*\\\<^sup>* (T \<^sup>*\\\<^sup>* U))"
       proof (cases V)
         show "V = [] \<Longrightarrow> ?thesis"
           using V by simp
         (*
          * TODO: I haven't found a better way to do this than just consider each combination
          * of T U V being a singleton.
          *)
         fix v V'
         assume V: "V = v # V'"
         show ?thesis
         proof (cases U)
           show "U = [] \<Longrightarrow> ?thesis"
             using U by simp
           fix u U'
           assume U: "U = u # U'"
           show ?thesis
           proof (cases T)
             show "T = [] \<Longrightarrow> ?thesis"
               using T by simp
             fix t T'
             assume T: "T = t # T'"
             show ?thesis
             proof (cases "V' = []", cases "U' = []", cases "T' = []")
               show "\<lbrakk>V' = []; U' = []; T' = []\<rbrakk> \<Longrightarrow> ?thesis"
                 using T U V R.cube Con_TU Resid.simps(2) Resid.simps(3) R.arr_resid_iff_con
                       R.con_implies_arr Con_sym
                 by metis
               assume T': "T' \<noteq> []" and V': "V' = []" and U': "U' = []"
               have 1: "U \<^sup>*\<frown>\<^sup>* [t]"
                 using T Con_TU Con_cons(2) Con_sym Resid.simps(2) by metis
               have 2: "V \<^sup>*\<frown>\<^sup>* [t]"
                 using V Con_VT Con_initial_right T by blast
               show ?thesis
               proof (intro conjI impI)
                 have 3: "length [t] + length U + length V \<le> n"
                   using T T' le_Suc_eq len by fastforce
                 show *: "V \<^sup>*\\\<^sup>* T \<^sup>*\<frown>\<^sup>* U \<^sup>*\\\<^sup>* T \<longleftrightarrow> V \<^sup>*\\\<^sup>* U \<^sup>*\<frown>\<^sup>* T \<^sup>*\\\<^sup>* U"
                 proof -
                   have "V \<^sup>*\\\<^sup>* T \<^sup>*\<frown>\<^sup>* U \<^sup>*\\\<^sup>* T \<longleftrightarrow> (V \<^sup>*\\\<^sup>* [t]) \<^sup>*\\\<^sup>* T' \<^sup>*\<frown>\<^sup>* (U \<^sup>*\\\<^sup>* [t]) \<^sup>*\\\<^sup>* T'"
                     using Con_TU Con_VT Con_sym Resid_cons(2) T T' by force
                   also have "... \<longleftrightarrow> V \<^sup>*\\\<^sup>* [t] \<^sup>*\<frown>\<^sup>* U \<^sup>*\\\<^sup>* [t] \<and>
                                      (V \<^sup>*\\\<^sup>* [t]) \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* [t]) \<^sup>*\<frown>\<^sup>* T' \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* [t])"
                   proof (intro iffI conjI)
                     show "(V \<^sup>*\\\<^sup>* [t]) \<^sup>*\\\<^sup>* T' \<^sup>*\<frown>\<^sup>* (U \<^sup>*\\\<^sup>* [t]) \<^sup>*\\\<^sup>* T' \<Longrightarrow> V \<^sup>*\\\<^sup>* [t] \<^sup>*\<frown>\<^sup>* U \<^sup>*\\\<^sup>* [t]"
                       using T U V T' U' V' 1 ind len Con_TU Con_rec(2) Resid_rec(1)
                             Resid.simps(1) length_Cons Suc_le_mono add_Suc
                       by (metis (no_types))
                     show "(V \<^sup>*\\\<^sup>* [t]) \<^sup>*\\\<^sup>* T' \<^sup>*\<frown>\<^sup>* (U \<^sup>*\\\<^sup>* [t]) \<^sup>*\\\<^sup>* T' \<Longrightarrow>
                           (V \<^sup>*\\\<^sup>* [t]) \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* [t]) \<^sup>*\<frown>\<^sup>* T' \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* [t])"
                       using T U V T' U' V'
                       by (metis Con_sym Resid.simps(1) Resid_rec(1) Suc_le_mono ind len
                           length_Cons list.size(3-4))
                     show "V \<^sup>*\\\<^sup>* [t] \<^sup>*\<frown>\<^sup>* U \<^sup>*\\\<^sup>* [t] \<and>
                           (V \<^sup>*\\\<^sup>* [t]) \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* [t]) \<^sup>*\<frown>\<^sup>* T' \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* [t]) \<Longrightarrow>
                             (V \<^sup>*\\\<^sup>* [t]) \<^sup>*\\\<^sup>* T' \<^sup>*\<frown>\<^sup>* (U \<^sup>*\\\<^sup>* [t]) \<^sup>*\\\<^sup>* T'"
                       using T U V T' U' V' 1 ind len Con_TU Con_VT Con_rec(1-3)
                       by (metis (no_types, lifting) One_nat_def Resid_rec(1) Suc_le_mono
                           add.commute list.size(3) list.size(4) plus_1_eq_Suc)
                   qed
                   also have "... \<longleftrightarrow> (V \<^sup>*\\\<^sup>* U) \<^sup>*\\\<^sup>* ([t] \<^sup>*\\\<^sup>* U) \<^sup>*\<frown>\<^sup>* T' \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* [t])"
                     by (metis 2 3 Con_sym ind Resid.simps(1))
                   also have "... \<longleftrightarrow> V \<^sup>*\\\<^sup>* U \<^sup>*\<frown>\<^sup>* T \<^sup>*\\\<^sup>* U"
                     using Con_rec(2) [of T' t]
                     by (metis (no_types, lifting) "1" Con_TU Con_cons(2) Resid.simps(1)
                         Resid.simps(3) Resid_rec(2) T T' U U')
                   finally show ?thesis by simp
                 qed
                 assume Con: "V \<^sup>*\\\<^sup>* T \<^sup>*\<frown>\<^sup>* U \<^sup>*\\\<^sup>* T"
                 show "(V \<^sup>*\\\<^sup>* T) \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* T) = (V \<^sup>*\\\<^sup>* U) \<^sup>*\\\<^sup>* (T \<^sup>*\\\<^sup>* U)"
                 proof -
                   have "(V \<^sup>*\\\<^sup>* T) \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* T) = ((V \<^sup>*\\\<^sup>* [t]) \<^sup>*\\\<^sup>* T') \<^sup>*\\\<^sup>* ((U \<^sup>*\\\<^sup>* [t]) \<^sup>*\\\<^sup>* T')"
                     using Con_TU Con_VT Con_sym Resid_cons(2) T T' by force
                   also have "... = ((V \<^sup>*\\\<^sup>* [t]) \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* [t])) \<^sup>*\\\<^sup>* (T' \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* [t]))"
                     using T U V T' U' V' 1 Con ind [of T' "Resid U [t]" "Resid V [t]"]
                     by (metis One_nat_def add.commute calculation len length_0_conv length_Resid
                         list.size(4) nat_add_left_cancel_le Con_sym plus_1_eq_Suc)
                   also have "... = ((V \<^sup>*\\\<^sup>* U) \<^sup>*\\\<^sup>* ([t] \<^sup>*\\\<^sup>* U)) \<^sup>*\\\<^sup>* (T' \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* [t]))"
                     by (metis "1" "2" "3" Con_sym ind)
                   also have "... = (V \<^sup>*\\\<^sup>* U) \<^sup>*\\\<^sup>* (T \<^sup>*\\\<^sup>* U)"
                     using T U T' U' Con *
                     by (metis Con_sym Resid_rec(1-2) Resid.simps(1) Resid_cons(2))
                   finally show ?thesis by simp
                 qed
               qed
               next
               assume U': "U' \<noteq> []" and V': "V' = []"
               show ?thesis
               proof (intro conjI impI)
                 show *: "V \<^sup>*\\\<^sup>* T \<^sup>*\<frown>\<^sup>* U \<^sup>*\\\<^sup>* T \<longleftrightarrow> V \<^sup>*\\\<^sup>* U \<^sup>*\<frown>\<^sup>* T \<^sup>*\\\<^sup>* U"
                 proof (cases "T' = []")
                   assume T': "T' = []"
                   show ?thesis
                   proof -
                     have "V \<^sup>*\\\<^sup>* T \<^sup>*\<frown>\<^sup>* U \<^sup>*\\\<^sup>* T \<longleftrightarrow> V \<^sup>*\\\<^sup>* [t] \<^sup>*\<frown>\<^sup>* (u \\ t) # (U' \<^sup>*\\\<^sup>* [t \\ u])"
                       using Con_TU Con_sym Resid_rec(2) T T' U U' by auto
                     also have "... \<longleftrightarrow> (V \<^sup>*\\\<^sup>* [t]) \<^sup>*\\\<^sup>* [u \\ t] \<^sup>*\<frown>\<^sup>* U' \<^sup>*\\\<^sup>* [t \\ u]"
                       by (metis Con_TU Con_cons(2) Con_rec(3) Con_sym Resid.simps(1) T U U')
                     also have "... \<longleftrightarrow> (V \<^sup>*\\\<^sup>* [u]) \<^sup>*\\\<^sup>* [t \\ u] \<^sup>*\<frown>\<^sup>* U' \<^sup>*\\\<^sup>* [t \\ u]"
                       using T U V V' R.cube_ax
                       apply simp
                       by (metis R.con_implies_arr(1) R.not_arr_null R.con_def)
                     also have "... \<longleftrightarrow> (V \<^sup>*\\\<^sup>* [u]) \<^sup>*\\\<^sup>* U' \<^sup>*\<frown>\<^sup>* [t \\ u] \<^sup>*\\\<^sup>* U'"
                     proof -
                       have "length [t \\ u] + length U' + length (V \<^sup>*\\\<^sup>* [u]) \<le> n"
                         using T U V V' len by force
                       thus ?thesis
                         by (metis Con_sym Resid.simps(1) add.commute ind)
                     qed
                     also have "... \<longleftrightarrow> V \<^sup>*\\\<^sup>* U \<^sup>*\<frown>\<^sup>* T \<^sup>*\\\<^sup>* U"
                       by (metis Con_TU Resid_cons(2) Resid_rec(3) T T' U U' Con_cons(2)
                           length_Resid length_0_conv)
                     finally show ?thesis by simp
                   qed
                   next
                   assume T': "T' \<noteq> []"
                   show ?thesis
                   proof -
                     have "V \<^sup>*\\\<^sup>* T \<^sup>*\<frown>\<^sup>* U \<^sup>*\\\<^sup>* T \<longleftrightarrow> (V \<^sup>*\\\<^sup>* [t]) \<^sup>*\\\<^sup>* T' \<^sup>*\<frown>\<^sup>* ((U \<^sup>*\\\<^sup>* [t]) \<^sup>*\\\<^sup>* T')"
                       using Con_TU Con_VT Con_sym Resid_cons(2) T T' by force
                     also have "... \<longleftrightarrow> (V \<^sup>*\\\<^sup>* [t]) \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* [t]) \<^sup>*\<frown>\<^sup>* T' \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* [t])"
                     proof -
                       have "length T' + length (U \<^sup>*\\\<^sup>* [t]) + length (V \<^sup>*\\\<^sup>* [t]) \<le> n"
                         by (metis (no_types, lifting) Con_TU Con_VT Con_initial_right Con_sym
                             One_nat_def Suc_eq_plus1 T ab_semigroup_add_class.add_ac(1)
                             add_le_imp_le_left len length_Resid list.size(4) plus_1_eq_Suc)
                       thus ?thesis
                         by (metis Con_TU Con_VT Con_cons(1) Con_cons(2) T T' U V ind list.discI)
                     qed
                     also have "... \<longleftrightarrow> (V \<^sup>*\\\<^sup>* U) \<^sup>*\\\<^sup>* ([t] \<^sup>*\\\<^sup>* U) \<^sup>*\<frown>\<^sup>* T' \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* [t])"
                     proof -
                       have "length [t] + length U + length V \<le> n"
                         using T T' le_Suc_eq len by fastforce
                       thus ?thesis
                         by (metis Con_TU Con_VT Con_initial_left Con_initial_right T ind)
                     qed
                     also have "... \<longleftrightarrow> V \<^sup>*\\\<^sup>* U \<^sup>*\<frown>\<^sup>* T \<^sup>*\\\<^sup>* U"
                       by (metis Con_cons(2) Con_sym Resid.simps(1) Resid1x_as_Resid
                           Residx1_as_Resid Resid_cons' T T')
                     finally show ?thesis by blast
                   qed
                 qed
                 show "V \<^sup>*\\\<^sup>* T \<^sup>*\<frown>\<^sup>* U \<^sup>*\\\<^sup>* T \<Longrightarrow>
                         (V \<^sup>*\\\<^sup>* T) \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* T) = (V \<^sup>*\\\<^sup>* U) \<^sup>*\\\<^sup>* (T \<^sup>*\\\<^sup>* U)"
                 proof -
                   assume Con: "V \<^sup>*\\\<^sup>* T \<^sup>*\<frown>\<^sup>* U \<^sup>*\\\<^sup>* T"
                   show ?thesis
                   proof (cases "T' = []")
                     assume T': "T' = []"
                     show ?thesis
                     proof -
                       have 1: "(V \<^sup>*\\\<^sup>* T) \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* T) =
                                (V \<^sup>*\\\<^sup>* T) \<^sup>*\\\<^sup>* ((u \\ t) # (U'\<^sup>*\\\<^sup>* [t \\ u]))"
                         using Con_TU Con_sym Resid_rec(2) T T' U U' by force
                       also have "... = ((V \<^sup>*\\\<^sup>* [t]) \<^sup>*\\\<^sup>* [u \\ t]) \<^sup>*\\\<^sup>* (U' \<^sup>*\\\<^sup>* [t \\ u])"
                         by (metis Con Con_TU Con_rec(2) Con_sym Resid_cons(2) T T' U U'
                             calculation)
                       also have "... = ((V \<^sup>*\\\<^sup>* [u]) \<^sup>*\\\<^sup>* [t \\ u]) \<^sup>*\\\<^sup>* (U' \<^sup>*\\\<^sup>* [t \\ u])"
                         by (metis "*" Con Con_rec(3) R.cube Resid.simps(1,3) T T' U V V'
                             calculation R.conI R.conE)
                       also have "... = ((V \<^sup>*\\\<^sup>* [u]) \<^sup>*\\\<^sup>* U') \<^sup>*\\\<^sup>* ([t \\ u] \<^sup>*\\\<^sup>* U')"
                       proof -
                         have "length [t \\ u] + length (U' \<^sup>*\\\<^sup>* [t \\ u]) + length (V \<^sup>*\\\<^sup>* [u]) \<le> n"
                           by (metis (no_types, lifting) Nat.le_diff_conv2 One_nat_def T U V V'
                               add.commute add_diff_cancel_left' add_leD2 len length_Cons
                               length_Resid list.size(3) plus_1_eq_Suc)
                         thus ?thesis
                           by (metis Con_sym add.commute Resid.simps(1) ind length_Resid)
                       qed
                       also have "... = (V \<^sup>*\\\<^sup>* U) \<^sup>*\\\<^sup>* (T \<^sup>*\\\<^sup>* U)"
                         by (metis Con_TU Con_cons(2) Resid_cons(2) T T' U U'
                             Resid_rec(3) length_0_conv length_Resid)
                       finally show ?thesis by blast
                     qed
                     next
                     assume T': "T' \<noteq> []"
                     show ?thesis
                     proof -
                       have "(V \<^sup>*\\\<^sup>* T) \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* T) =
                             ((V \<^sup>*\\\<^sup>* T) \<^sup>*\\\<^sup>* ([u] \<^sup>*\\\<^sup>* T)) \<^sup>*\\\<^sup>* (U' \<^sup>*\\\<^sup>* (T \<^sup>*\\\<^sup>* [u]))"
                         by (metis Con Con_TU Resid.simps(2) Resid1x_as_Resid U U'
                             Con_cons(2) Con_sym Resid_cons' Resid_cons(2))
                       also have "... = ((V \<^sup>*\\\<^sup>* [u]) \<^sup>*\\\<^sup>* (T \<^sup>*\\\<^sup>* [u])) \<^sup>*\\\<^sup>* (U' \<^sup>*\\\<^sup>* (T \<^sup>*\\\<^sup>* [u]))"
                       proof -
                         have "length T + length [u] + length V \<le> n"
                           using U U' antisym_conv len not_less_eq_eq by fastforce
                         thus ?thesis
                           by (metis Con_TU Con_VT Con_initial_right U ind)
                       qed
                       also have "... = ((V \<^sup>*\\\<^sup>* [u]) \<^sup>*\\\<^sup>* U') \<^sup>*\\\<^sup>* ((T \<^sup>*\\\<^sup>* [u]) \<^sup>*\\\<^sup>* U')"
                       proof -
                         have "length (T \<^sup>*\\\<^sup>* [u]) + length U' + length (V \<^sup>*\\\<^sup>* [u]) \<le> n"
                           using Con_TU Con_initial_right U V V' len length_Resid by force
                         thus ?thesis
                           by (metis Con Con_TU Con_cons(2) U U' calculation ind length_0_conv
                               length_Resid)
                       qed
                       also have "... = (V \<^sup>*\\\<^sup>* U) \<^sup>*\\\<^sup>* (T \<^sup>*\\\<^sup>* U)"
                         by (metis "*" Con Con_TU Resid_cons(2) U U' length_Resid length_0_conv)
                       finally show ?thesis by blast
                     qed
                   qed
                 qed
               qed
               next
               assume V': "V' \<noteq> []"
               show ?thesis
               proof (cases "U' = []")
                 assume U': "U' = []"
                 show ?thesis
                 proof (cases "T' = []")
                   assume T': "T' = []"
                   show ?thesis
                   proof (intro conjI impI)
                     show *: "V \<^sup>*\\\<^sup>* T \<^sup>*\<frown>\<^sup>* U \<^sup>*\\\<^sup>* T \<longleftrightarrow>  V \<^sup>*\\\<^sup>* U \<^sup>*\<frown>\<^sup>* T \<^sup>*\\\<^sup>* U"
                     proof -
                       have "V \<^sup>*\\\<^sup>* T \<^sup>*\<frown>\<^sup>* U \<^sup>*\\\<^sup>* T \<longleftrightarrow> (v \\ t) # (V' \<^sup>*\\\<^sup>* [t \\ v]) \<^sup>*\<frown>\<^sup>* [u \\ t]"
                         using Con_TU Con_VT Con_sym Resid_rec(1-2) T T' U U' V V'
                         by metis
                       also have "... \<longleftrightarrow> [v \\ t] \<^sup>*\<frown>\<^sup>* [u \\ t] \<and>
                                          V' \<^sup>*\\\<^sup>* [t \\ v] \<^sup>*\<frown>\<^sup>* [u \\ v] \<^sup>*\\\<^sup>* [t \\ v]"
                         by (metis T T' V V' Con_VT Con_rec(1-2) Con_sym R.con_def R.cube
                             Resid.simps(3))
                       also have "... \<longleftrightarrow> [v \\ t] \<^sup>*\<frown>\<^sup>* [u \\ t] \<and>
                                          V' \<^sup>*\\\<^sup>* [u \\ v] \<^sup>*\<frown>\<^sup>* [t \\ v] \<^sup>*\\\<^sup>* [u \\ v]"
                       proof -
                         have "length [t \\ v] + length [u \\ v] + length V' \<le> n"
                           using T U V len by fastforce
                         thus ?thesis
                           by (metis Con_imp_Arr_Resid Arr_has_Src Con_VT T T' Trgs.simps(1)
                               Trgs_Resid_sym V V' Con_rec(2) Srcs_Resid ind)
                       qed
                       also have "... \<longleftrightarrow> [v \\ t] \<^sup>*\<frown>\<^sup>* [u \\ t] \<and>
                                          V' \<^sup>*\\\<^sup>* [u \\ v] \<^sup>*\<frown>\<^sup>* [t \\ u] \<^sup>*\\\<^sup>* [v \\ u]"
                         by (simp add: R.con_def R.cube)
                       also have "... \<longleftrightarrow> V \<^sup>*\\\<^sup>* U \<^sup>*\<frown>\<^sup>* T \<^sup>*\\\<^sup>* U"
                       proof
                         assume 1: "V \<^sup>*\\\<^sup>* U \<^sup>*\<frown>\<^sup>* T \<^sup>*\\\<^sup>* U"
                         have tu_vu: "t \\ u \<frown> v \\ u"
                           by (metis (no_types, lifting) 1 T T' U U' V V' Con_rec(3)
                               Resid_rec(1-2) Con_sym length_Resid length_0_conv)
                         have vt_ut: "v \\ t \<frown> u \\ t"
                           using 1
                           by (metis R.con_def R.con_sym R.cube tu_vu)
                         show "[v \\ t] \<^sup>*\<frown>\<^sup>* [u \\ t] \<and> V' \<^sup>*\\\<^sup>* [u \\ v] \<^sup>*\<frown>\<^sup>* [t \\ u] \<^sup>*\\\<^sup>* [v \\ u]"
                           by (metis (no_types, lifting) "1" Con_TU Con_cons(1) Con_rec(1-2)
                               Resid_rec(1) T T' U U' V V' Resid_rec(2) length_Resid
                               length_0_conv vt_ut)
                         next
                         assume 1: "[v \\ t] \<^sup>*\<frown>\<^sup>* [u \\ t] \<and>
                                    V' \<^sup>*\\\<^sup>* [u \\ v] \<^sup>*\<frown>\<^sup>* [t \\ u] \<^sup>*\\\<^sup>* [v \\ u]"
                         have tu_vu: "t \\ u \<frown> v \\ u \<and> v \\ t \<frown> u \\ t"
                           by (metis 1 Con_sym Resid.simps(1) Residx1.simps(2)
                               Residx1_as_Resid)
                         have tu: "t \<frown> u"
                           using Con_TU Con_rec(1) T T' U U' by blast
                         show "V \<^sup>*\\\<^sup>* U \<^sup>*\<frown>\<^sup>* T \<^sup>*\\\<^sup>* U"
                           by (metis (no_types, opaque_lifting) 1 Con_rec(2) Con_sym
                               R.con_implies_arr(2) Resid.simps(1,3) T T' U U' V V'
                               Resid_rec(2) R.arr_resid_iff_con)
                       qed
                       finally show ?thesis by simp
                     qed
                     show "V \<^sup>*\\\<^sup>* T \<^sup>*\<frown>\<^sup>* U \<^sup>*\\\<^sup>* T \<Longrightarrow>
                             (V \<^sup>*\\\<^sup>* T) \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* T) = (V \<^sup>*\\\<^sup>* U) \<^sup>*\\\<^sup>* (T \<^sup>*\\\<^sup>* U)"
                     proof -
                       assume Con: "V \<^sup>*\\\<^sup>* T \<^sup>*\<frown>\<^sup>* U \<^sup>*\\\<^sup>* T"
                       have "(V \<^sup>*\\\<^sup>* T) \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* T) = ((v \\ t) # (V' \<^sup>*\\\<^sup>* [t \\ v])) \<^sup>*\\\<^sup>* [u \\ t]"
                         using Con_TU Con_VT Con_sym Resid_rec(1-2) T T' U U' V V' by metis
                       also have 1: "... = ((v \\ t) \\ (u \\ t)) #
                                             (V' \<^sup>*\\\<^sup>* [t \\ v]) \<^sup>*\\\<^sup>* ([u \\ v] \<^sup>*\\\<^sup>* [t \\ v])"
                         apply simp
                         by (metis Con Con_VT Con_rec(2) R.conE R.conI R.con_sym R.cube
                             Resid_rec(2) T T' V V' calculation(1))
                       also have "... = ((v \\ t) \\ (u \\ t)) #
                                          (V' \<^sup>*\\\<^sup>* [u \\ v]) \<^sup>*\\\<^sup>* ([t \\ v] \<^sup>*\\\<^sup>* [u \\ v])"
                       proof -
                         have "length [t \\ v] + length [u \\ v] + length V' \<le> n"
                           using T U V len by fastforce
                         moreover have "u \\ v \<frown> t \\ v"
                           by (metis 1 Con_VT Con_rec(2) R.con_sym_ax T T' V V' list.discI
                               R.conE R.conI R.cube)
                         moreover have "t \\ v \<frown> u \\ v"
                           using R.con_sym calculation(2) by blast
                         ultimately show ?thesis
                           by (metis Con_VT Con_rec(2) T T' V V' Con_rec(1) ind)
                       qed
                       also have "... = ((v \\ t) \\ (u \\ t)) #
                                          ((V' \<^sup>*\\\<^sup>* [u \\ v]) \<^sup>*\\\<^sup>* ([t \\ u] \<^sup>*\\\<^sup>* [v \\ u]))"
                         using R.cube by fastforce
                       also have "... = ((v \\ u) \\ (t \\ u)) #
                                          ((V' \<^sup>*\\\<^sup>* [u \\ v]) \<^sup>*\\\<^sup>* ([t \\ u] \<^sup>*\\\<^sup>* [v \\ u]))"
                         by (metis R.cube)
                       also have "... = (V \<^sup>*\\\<^sup>* U) \<^sup>*\\\<^sup>* (T \<^sup>*\\\<^sup>* U)"
                       proof -
                         have "(V \<^sup>*\\\<^sup>* U) \<^sup>*\\\<^sup>* (T \<^sup>*\\\<^sup>* U) = ((v \\ u) # ((V' \<^sup>*\\\<^sup>* [u \\ v]))) \<^sup>*\\\<^sup>* [t \\ u]"
                            using T T' U U' V Resid_cons(1) [of "[u]" v V']
                            by (metis "*" Con Con_TU Resid.simps(1) Resid_rec(1) Resid_rec(2))
                         also have "... = ((v \\ u) \\ (t \\ u)) #
                                            ((V' \<^sup>*\\\<^sup>* [u \\ v]) \<^sup>*\\\<^sup>* ([t \\ u] \<^sup>*\\\<^sup>* [v \\ u]))"
                           by (metis "*" Con Con_initial_left calculation Con_sym Resid.simps(1)
                                     Resid_rec(1-2))
                         finally show ?thesis by simp
                       qed
                       finally show ?thesis by simp
                     qed
                   qed
                   next
                   assume T': "T' \<noteq> []"
                   show ?thesis
                   proof (intro conjI impI)
                     show *: "V \<^sup>*\\\<^sup>* T \<^sup>*\<frown>\<^sup>* U \<^sup>*\\\<^sup>* T \<longleftrightarrow>  V \<^sup>*\\\<^sup>* U \<^sup>*\<frown>\<^sup>* T \<^sup>*\\\<^sup>* U"
                     proof -
                       have "V \<^sup>*\\\<^sup>* T \<^sup>*\<frown>\<^sup>* U \<^sup>*\\\<^sup>* T \<longleftrightarrow> (V \<^sup>*\\\<^sup>* [t]) \<^sup>*\\\<^sup>* T' \<^sup>*\<frown>\<^sup>* [u \\ t] \<^sup>*\\\<^sup>* T'"
                         using Con_TU Con_VT Con_sym Resid_cons(2) Resid_rec(3) T T' U U'
                         by force
                       also have "... \<longleftrightarrow> (V \<^sup>*\\\<^sup>* [t]) \<^sup>*\\\<^sup>* [u \\ t] \<^sup>*\<frown>\<^sup>* T' \<^sup>*\\\<^sup>* [u \\ t]"
                       proof -
                         have "length [u \\ t] + length T' + length (V \<^sup>*\\\<^sup>* [t]) \<le> n"
                           using Con_VT Con_initial_right T U length_Resid len by fastforce
                         thus ?thesis
                           by (metis Con_TU Con_VT Con_rec(2) T T' U V add.commute Con_cons(2)
                               ind list.discI)
                       qed
                       also have "... \<longleftrightarrow> (V \<^sup>*\\\<^sup>* [u]) \<^sup>*\\\<^sup>* [t \\ u] \<^sup>*\<frown>\<^sup>* T' \<^sup>*\\\<^sup>* [u \\ t]"
                       proof -
                         have "length [t] + length [u] + length V \<le> n"
                           using T T' U le_Suc_eq len by fastforce
                         hence "(V \<^sup>*\\\<^sup>* [t]) \<^sup>*\\\<^sup>* ([u] \<^sup>*\\\<^sup>* [t]) = (V \<^sup>*\\\<^sup>* [u]) \<^sup>*\\\<^sup>* ([t] \<^sup>*\\\<^sup>* [u])"
                           using ind [of "[t]" "[u]" V]
                           by (metis Con_TU Con_VT Con_initial_left Con_initial_right T U)
                         thus ?thesis
                           by (metis (full_types) Con_TU Con_initial_left Con_sym Resid_rec(1) T U)
                       qed
                       also have "... \<longleftrightarrow> V \<^sup>*\\\<^sup>* U \<^sup>*\<frown>\<^sup>* T \<^sup>*\\\<^sup>* U"
                         by (metis Con_TU Con_cons(2) Con_rec(2) Resid.simps(1) Resid_rec(2)
                             T T' U U')
                       finally show ?thesis by simp
                     qed
                     show "V \<^sup>*\\\<^sup>* T \<^sup>*\<frown>\<^sup>* U \<^sup>*\\\<^sup>* T \<Longrightarrow>
                            (V \<^sup>*\\\<^sup>* T) \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* T) = (V \<^sup>*\\\<^sup>* U) \<^sup>*\\\<^sup>* (T \<^sup>*\\\<^sup>* U)"
                     proof -
                       assume Con: "V \<^sup>*\\\<^sup>* T \<^sup>*\<frown>\<^sup>* U \<^sup>*\\\<^sup>* T"
                       have "(V \<^sup>*\\\<^sup>* T) \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* T) = ((V \<^sup>*\\\<^sup>* [t]) \<^sup>*\\\<^sup>* T') \<^sup>*\\\<^sup>* ([u \\ t] \<^sup>*\\\<^sup>* T')"
                         using Con_TU Con_VT Con_sym Resid_cons(2) Resid_rec(3) T T' U U'
                         by force
                       also have "... = ((V \<^sup>*\\\<^sup>* [t]) \<^sup>*\\\<^sup>* [u \\ t]) \<^sup>*\\\<^sup>* (T' \<^sup>*\\\<^sup>* [u \\ t])"
                       proof -
                         have "length [u \\ t] + length T' + length (Resid V [t]) \<le> n"
                           using Con_VT Con_initial_right T U length_Resid len by fastforce
                         thus ?thesis
                           by (metis Con_TU Con_VT Con_cons(2) Con_rec(2) T T' U V add.commute
                               ind list.discI)
                       qed
                       also have "... = ((V \<^sup>*\\\<^sup>* [u]) \<^sup>*\\\<^sup>* [t \\ u]) \<^sup>*\\\<^sup>* (T' \<^sup>*\\\<^sup>* [u \\ t])"
                       proof -
                         have "length [t] + length [u] + length V \<le> n"
                           using T T' U le_Suc_eq len by fastforce
                         thus ?thesis
                           using ind [of "[t]" "[u]" V]
                           by (metis Con_TU Con_VT Con_initial_left Con_sym Resid_rec(1) T U)
                       qed
                       also have "... = (V \<^sup>*\\\<^sup>* U) \<^sup>*\\\<^sup>* (T \<^sup>*\\\<^sup>* U)"
                         using * Con Con_TU Con_rec(2) Resid_cons(2) Resid_rec(2) T T' U U'
                         by auto
                       finally show ?thesis by simp
                     qed
                   qed
                 qed
                 next
                 assume U': "U' \<noteq> []"
                 show ?thesis
                 proof (cases "T' = []")
                   assume T': "T' = []"
                   show ?thesis
                   proof (intro conjI impI)
                     show *: "V \<^sup>*\\\<^sup>* T \<^sup>*\<frown>\<^sup>* U \<^sup>*\\\<^sup>* T \<longleftrightarrow> V \<^sup>*\\\<^sup>* U \<^sup>*\<frown>\<^sup>* T \<^sup>*\\\<^sup>* U"
                     proof -
                       have "V \<^sup>*\\\<^sup>* T \<^sup>*\<frown>\<^sup>* U \<^sup>*\\\<^sup>* T \<longleftrightarrow> V \<^sup>*\\\<^sup>* [t] \<^sup>*\<frown>\<^sup>* (u \\ t) # (U' \<^sup>*\\\<^sup>* [t \\ u])"
                         using T U V T' U' V' Con_TU Con_VT Con_sym Resid_rec(2) by auto
                       also have "... \<longleftrightarrow> V \<^sup>*\\\<^sup>* [t] \<^sup>*\<frown>\<^sup>* [u \\ t] \<and>
                                          (V \<^sup>*\\\<^sup>* [t]) \<^sup>*\\\<^sup>* [u \\ t] \<^sup>*\<frown>\<^sup>* U' \<^sup>*\\\<^sup>* [t \\ u]"
                         by (metis Con_TU Con_VT Con_cons(2) Con_initial_right
                             Con_rec(2) Con_sym T U U')
                       also have "... \<longleftrightarrow> V \<^sup>*\\\<^sup>* [t] \<^sup>*\<frown>\<^sup>* [u \\ t] \<and>
                                          (V \<^sup>*\\\<^sup>* [u]) \<^sup>*\\\<^sup>* [t \\ u] \<^sup>*\<frown>\<^sup>* U' \<^sup>*\\\<^sup>* [t \\ u]"
                       proof -
                         have "length [u] + length [t] + length V \<le> n"
                           using T U V T' U' V' len not_less_eq_eq order_trans by fastforce
                         thus ?thesis
                           using ind [of "[t]" "[u]" V]
                           by (metis Con_TU Con_VT Con_initial_right Resid_rec(1) T U
                                     Con_sym length_Cons)
                       qed
                       also have "... \<longleftrightarrow> V \<^sup>*\\\<^sup>* [u] \<^sup>*\<frown>\<^sup>* [t \\ u] \<and>
                                          (V \<^sup>*\\\<^sup>* [u]) \<^sup>*\\\<^sup>* [t \\ u] \<^sup>*\<frown>\<^sup>* U' \<^sup>*\\\<^sup>* [t \\ u]"
                       proof -
                         have "length [t] + length [u] + length V \<le> n"
                           using T U V T' U' V' len antisym_conv not_less_eq_eq by fastforce
                         thus ?thesis
                           by (metis (full_types) Con_TU Con_VT Con_initial_right Con_sym
                               Resid_rec(1) T U ind)
                       qed
                       also have "... \<longleftrightarrow> (V \<^sup>*\\\<^sup>* [u]) \<^sup>*\\\<^sup>* U' \<^sup>*\<frown>\<^sup>* [t \\ u] \<^sup>*\\\<^sup>* U'"
                       proof -
                         have "length [t \\ u] + length U' + length (V \<^sup>*\\\<^sup>* [u]) \<le> n"
                           by (metis T T' U add.assoc add.right_neutral add_leD1
                               add_le_cancel_left length_Resid len length_Cons list.size(3)
                               plus_1_eq_Suc)
                         thus ?thesis
                           by (metis (no_types, opaque_lifting) Con_sym Resid.simps(1)
                               add.commute ind)
                       qed
                       also have "... \<longleftrightarrow> V \<^sup>*\\\<^sup>* U \<^sup>*\<frown>\<^sup>* T \<^sup>*\\\<^sup>* U"
                         by (metis Con_TU Resid_cons(2) Resid_rec(3) T T' U U'
                             Con_cons(2) length_Resid length_0_conv)
                       finally show ?thesis by blast
                     qed
                     show "V \<^sup>*\\\<^sup>* T \<^sup>*\<frown>\<^sup>* U \<^sup>*\\\<^sup>* T \<Longrightarrow>
                            (V \<^sup>*\\\<^sup>* T) \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* T) = (V \<^sup>*\\\<^sup>* U) \<^sup>*\\\<^sup>* (T \<^sup>*\\\<^sup>* U)"
                     proof -
                       assume Con: "V \<^sup>*\\\<^sup>* T \<^sup>*\<frown>\<^sup>* U \<^sup>*\\\<^sup>* T"
                       have "(V \<^sup>*\\\<^sup>* T) \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* T) =
                             (V \<^sup>*\\\<^sup>* [t]) \<^sup>*\\\<^sup>* ((u \\ t) # (U' \<^sup>*\\\<^sup>* [t \\ u]))"
                         using Con_TU Con_sym Resid_rec(2) T T' U U' by auto
                      also have "... = ((V \<^sup>*\\\<^sup>* [t]) \<^sup>*\\\<^sup>* [u \\ t]) \<^sup>*\\\<^sup>* (U' \<^sup>*\\\<^sup>* [t \\ u])"
                         by (metis Con Con_TU Con_rec(2) Con_sym T T' U U' calculation
                             Resid_cons(2))
                       also have "... = ((V \<^sup>*\\\<^sup>* [u]) \<^sup>*\\\<^sup>* [t \\ u]) \<^sup>*\\\<^sup>* (U' \<^sup>*\\\<^sup>* [t \\ u])"
                       proof -
                         have "length [t] + length [u] + length V \<le> n"
                           using T U U' le_Suc_eq len by fastforce
                         thus ?thesis
                           using T U Con_TU Con_VT Con_sym ind [of "[t]" "[u]" V]
                           by (metis (no_types, opaque_lifting) Con_initial_right Resid.simps(3))
                       qed
                       also have "... = ((V \<^sup>*\\\<^sup>* [u]) \<^sup>*\\\<^sup>* U') \<^sup>*\\\<^sup>* ([t \\ u] \<^sup>*\\\<^sup>* U')"
                       proof -
                         have "length [t \\ u] + length U' + length (V \<^sup>*\\\<^sup>* [u]) \<le> n"
                           by (metis (no_types, opaque_lifting) T T' U add.left_commute
                               add.right_neutral add_leD2 add_le_cancel_left len length_Cons
                               length_Resid list.size(3) plus_1_eq_Suc)
                         thus ?thesis
                           by (metis Con Con_TU Con_rec(3) T T' U U' calculation
                               ind length_0_conv length_Resid)
                       qed
                       also have "... = (V \<^sup>*\\\<^sup>* U) \<^sup>*\\\<^sup>* (T \<^sup>*\\\<^sup>* U)"
                         by (metis "*" Con Con_TU Resid_rec(3) T T' U U' Resid_cons(2)
                             length_Resid length_0_conv)
                       finally show ?thesis by blast
                     qed
                   qed
                   next
                   assume T': "T' \<noteq> []"
                   show ?thesis
                   proof (intro conjI impI)
                     have 1: "U \<^sup>*\<frown>\<^sup>* [t]"
                       using T Con_TU
                       by (metis Con_cons(2) Con_sym Resid.simps(2))
                     have 2: "V \<^sup>*\<frown>\<^sup>* [t]"
                       using V Con_VT Con_initial_right T by blast
                     have 3: "length T' + length (U \<^sup>*\\\<^sup>* [t]) + length (V \<^sup>*\\\<^sup>* [t]) \<le> n"
                       using "1" "2" T len length_Resid by force
                     have 4: "length [t] + length U + length V \<le> n"
                       using T T' len antisym_conv not_less_eq_eq by fastforce
                     show *: "V \<^sup>*\\\<^sup>* T \<^sup>*\<frown>\<^sup>* U \<^sup>*\\\<^sup>* T \<longleftrightarrow> V \<^sup>*\\\<^sup>* U \<^sup>*\<frown>\<^sup>* T \<^sup>*\\\<^sup>* U"
                     proof -
                       have "V \<^sup>*\\\<^sup>* T \<^sup>*\<frown>\<^sup>* U \<^sup>*\\\<^sup>* T \<longleftrightarrow> (V \<^sup>*\\\<^sup>* [t]) \<^sup>*\\\<^sup>* T' \<^sup>*\<frown>\<^sup>* (U \<^sup>*\\\<^sup>* [t]) \<^sup>*\\\<^sup>* T'"
                         using Con_TU Con_VT Con_sym Resid_cons(2) T T' by force
                       also have "... \<longleftrightarrow> (V \<^sup>*\\\<^sup>* [t]) \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* [t]) \<^sup>*\<frown>\<^sup>* T' \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* [t])"
                         by (metis 3 Con_TU Con_VT Con_cons(1) Con_cons(2) T T' U V ind
                             list.discI)
                       also have "... \<longleftrightarrow> (V \<^sup>*\\\<^sup>* U) \<^sup>*\\\<^sup>* ([t] \<^sup>*\\\<^sup>* U) \<^sup>*\<frown>\<^sup>* T' \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* [t])"
                         by (metis 1 2 4 Con_sym ind)
                       also have "... \<longleftrightarrow> V \<^sup>*\\\<^sup>* U \<^sup>*\<frown>\<^sup>* hd ([t] \<^sup>*\\\<^sup>* U) # T' \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* [t])"
                         by (metis 1 Con_TU Con_cons(1) Con_cons(2) Resid.simps(1)
                             Resid1x_as_Resid T T' list.sel(1))
                       also have "... \<longleftrightarrow> V \<^sup>*\\\<^sup>* U \<^sup>*\<frown>\<^sup>* T \<^sup>*\\\<^sup>* U"
                         using 1 Resid_cons' [of T' t U] Con_TU T T' Resid1x_as_Resid
                               Con_sym
                         by force
                       finally show ?thesis by simp
                     qed
                     show "(V \<^sup>*\\\<^sup>* T) \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* T) = (V \<^sup>*\\\<^sup>* U) \<^sup>*\\\<^sup>* (T \<^sup>*\\\<^sup>* U)"
                     proof -
                       have "(V \<^sup>*\\\<^sup>* T) \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* T) =
                             ((V \<^sup>*\\\<^sup>* [t]) \<^sup>*\\\<^sup>* T') \<^sup>*\\\<^sup>* ((U \<^sup>*\\\<^sup>* [t]) \<^sup>*\\\<^sup>* T')"
                         using Con_TU Con_VT Con_sym Resid_cons(2) T T' by force
                       also have "... = ((V \<^sup>*\\\<^sup>* [t]) \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* [t])) \<^sup>*\\\<^sup>* (T' \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* [t]))"
                         by (metis (no_types, lifting) "3" Con_TU Con_VT T T' U V Con_cons(1)
                             Con_cons(2) ind list.simps(3))
                       also have "... = ((V \<^sup>*\\\<^sup>* U) \<^sup>*\\\<^sup>* ([t] \<^sup>*\\\<^sup>* U)) \<^sup>*\\\<^sup>* (T' \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* [t]))"
                         by (metis 1 2 4 Con_sym ind)
                       also have "... = (V \<^sup>*\\\<^sup>* U) \<^sup>*\\\<^sup>* ((t # T') \<^sup>*\\\<^sup>* U)"
                         by (metis "*" Con_TU Con_cons(1) Resid1x_as_Resid
                             Resid_cons' T T' U calculation Resid_cons(2) list.distinct(1))
                       also have "... = (V \<^sup>*\\\<^sup>* U) \<^sup>*\\\<^sup>* (T \<^sup>*\\\<^sup>* U)"
                         using T by fastforce
                       finally show ?thesis by simp
                     qed
                   qed
                 qed
               qed
             qed
           qed
         qed
       qed
     qed
 
     lemma Cube:
     shows "T \<^sup>*\\\<^sup>* U \<^sup>*\<frown>\<^sup>* V \<^sup>*\\\<^sup>* U \<longleftrightarrow> T \<^sup>*\\\<^sup>* V \<^sup>*\<frown>\<^sup>* U \<^sup>*\\\<^sup>* V"
     and "T \<^sup>*\\\<^sup>* U \<^sup>*\<frown>\<^sup>* V \<^sup>*\\\<^sup>* U \<Longrightarrow> (T \<^sup>*\\\<^sup>* U) \<^sup>*\\\<^sup>* (V \<^sup>*\\\<^sup>* U) = (T \<^sup>*\\\<^sup>* V) \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* V)"
     proof -
       show "T \<^sup>*\\\<^sup>* U \<^sup>*\<frown>\<^sup>* V \<^sup>*\\\<^sup>* U \<longleftrightarrow> T \<^sup>*\\\<^sup>* V \<^sup>*\<frown>\<^sup>* U \<^sup>*\\\<^sup>* V"
         using Cube_ind by (metis Con_sym Resid.simps(1) le_add2)
       show "T \<^sup>*\\\<^sup>* U \<^sup>*\<frown>\<^sup>* V \<^sup>*\\\<^sup>* U \<Longrightarrow> (T \<^sup>*\\\<^sup>* U) \<^sup>*\\\<^sup>* (V \<^sup>*\\\<^sup>* U) = (T \<^sup>*\\\<^sup>* V) \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* V)"
         using Cube_ind by (metis Con_sym Resid.simps(1) order_refl)
     qed
 
     lemma Con_implies_Arr:
     assumes "T \<^sup>*\<frown>\<^sup>* U"
     shows "Arr T" and "Arr U"
       using assms Con_sym
       by (metis Con_imp_Arr_Resid Arr_iff_Con_self Cube(1) Resid.simps(1))+
 
     sublocale partial_magma Resid
       by (unfold_locales, metis Resid.simps(1) Con_sym)
 
     lemma is_partial_magma:
     shows "partial_magma Resid"
       ..
 
     lemma null_char:
     shows "null = []"
       by (metis null_is_zero(2) Resid.simps(1))
 
     sublocale residuation Resid
       using null_char Con_sym Arr_iff_Con_self Con_imp_Arr_Resid Cube null_is_zero(2)
       by unfold_locales auto
 
     lemma is_residuation:
     shows "residuation Resid"
       ..
 
     lemma arr_char:
     shows "arr T \<longleftrightarrow> Arr T"
       using null_char Arr_iff_Con_self by fastforce
 
     lemma arrI\<^sub>P [intro]:
     assumes "Arr T"
     shows "arr T"
       using assms arr_char by auto
 
     lemma ide_char:
     shows "ide T \<longleftrightarrow> Ide T"
       by (metis Con_Arr_self Ide_implies_Arr Resid_Arr_Ide_ind Resid_Arr_self arr_char ide_def
           arr_def)
 
     lemma con_char:
     shows "con T U \<longleftrightarrow> Con T U"
       using null_char by auto
 
     lemma conI\<^sub>P [intro]:
     assumes "Con T U"
     shows "con T U"
       using assms con_char by auto
 
     sublocale rts Resid
     proof
       show "\<And>A T. \<lbrakk>ide A; con T A\<rbrakk> \<Longrightarrow> T \<^sup>*\\\<^sup>* A = T"
         using Resid_Arr_Ide_ind ide_char null_char by auto
       show "\<And>T. arr T \<Longrightarrow> ide (trg T)"
         by (metis arr_char Resid_Arr_self ide_char resid_arr_self)
       show "\<And>A T. \<lbrakk>ide A; con A T\<rbrakk> \<Longrightarrow> ide (A \<^sup>*\\\<^sup>* T)"
         by (simp add: Resid_Ide_Arr_ind con_char ide_char)
       show "\<And>T U. con T U \<Longrightarrow> \<exists>A. ide A \<and> con A T \<and> con A U"
       proof -
         fix T U
         assume TU: "con T U"
         have 1: "Srcs T = Srcs U"
           using TU Con_imp_eq_Srcs con_char by force
         obtain a where a: "a \<in> Srcs T \<inter> Srcs U"
           using 1
           by (metis Int_absorb Int_emptyI TU arr_char Arr_has_Src con_implies_arr(1))
         show "\<exists>A. ide A \<and> con A T \<and> con A U"
           using a 1
           by (metis (full_types) Ball_Collect Con_single_ide_ind Ide.simps(2) Int_absorb TU
               Srcs_are_ide arr_char con_char con_implies_arr(1-2) ide_char)
       qed
       show "\<And>T U V. \<lbrakk>ide (Resid T U); con U V\<rbrakk> \<Longrightarrow> con (T \<^sup>*\\\<^sup>* U) (V \<^sup>*\\\<^sup>* U)"
         using null_char ide_char
         by (metis Con_imp_Arr_Resid Con_Ide_iff Srcs_Resid con_char con_sym arr_resid_iff_con
             ide_implies_arr)
     qed
 
     theorem is_rts:
     shows "rts Resid"
       ..
 
     notation cong  (infix "\<^sup>*\<sim>\<^sup>*" 50)
     notation prfx  (infix "\<^sup>*\<lesssim>\<^sup>*" 50)
 
     lemma sources_char\<^sub>P:
     shows "sources T = {A. Ide A \<and> Arr T \<and> Srcs A = Srcs T}"
       using Con_Ide_iff Con_sym con_char ide_char sources_def by fastforce
 
     lemma sources_cons:
     shows "Arr (t # T) \<Longrightarrow> sources (t # T) = sources [t]"
       apply (induct T)
        apply simp
       using sources_char\<^sub>P by auto
 
     lemma targets_char\<^sub>P:
     shows "targets T = {B. Ide B \<and> Arr T \<and> Srcs B = Trgs T}"
       unfolding targets_def
       by (metis (no_types, lifting) trg_def Arr.simps(1) Ide_implies_Arr Resid_Arr_self
           arr_char Con_Ide_iff Srcs_Resid con_char ide_char con_implies_arr(1))
 
     lemma seq_char':
     shows "seq T U \<longleftrightarrow> Arr T \<and> Arr U \<and> Trgs T \<inter> Srcs U \<noteq> {}"
     proof
       show "seq T U \<Longrightarrow> Arr T \<and> Arr U \<and> Trgs T \<inter> Srcs U \<noteq> {}"
         unfolding seq_def
         using Arr_has_Trg arr_char Con_Arr_self sources_char\<^sub>P trg_def trg_in_targets
         by fastforce
       assume 1: "Arr T \<and> Arr U \<and> Trgs T \<inter> Srcs U \<noteq> {}"
       have "targets T = sources U"
       proof -
         obtain a where a: "R.ide a \<and> a \<in> Trgs T \<and> a \<in> Srcs U"
           using 1 Trgs_are_ide by blast
         have "Trgs [a] = Trgs T"
           using a 1
           by (metis Con_single_ide_ind Con_sym Resid_Arr_Src Srcs_Resid Trgs_eqI)
         moreover have "Srcs [a] = Srcs U"
           using a 1 Con_single_ide_ind Con_imp_eq_Srcs by blast
         moreover have "Trgs [a] = Srcs [a]"
           using a
           by (metis R.residuation_axioms R.sources_resid Srcs.simps(2) Trgs.simps(2)
               residuation.ideE)
         ultimately show ?thesis
           using 1 sources_char\<^sub>P targets_char\<^sub>P by auto
       qed
       thus "seq T U"
         using 1 by blast
     qed
       
     lemma seq_char:
     shows "seq T U \<longleftrightarrow> Arr T \<and> Arr U \<and> Trgs T = Srcs U"
       by (metis Int_absorb Srcs_Resid Arr_has_Src Arr_iff_Con_self Srcs_eqI seq_char')
 
     lemma seqI\<^sub>P [intro]:
     assumes "Arr T" and "Arr U" and "Trgs T \<inter> Srcs U \<noteq> {}"
     shows "seq T U"
       using assms seq_char' by auto
 
     lemma Ide_imp_sources_eq_targets:
     assumes "Ide T"
     shows "sources T = targets T"
       using assms
       by (metis Resid_Arr_Ide_ind arr_iff_has_source arr_iff_has_target con_char
           arr_def sources_resid)
 
     subsection "Inclusion Map"
 
     text \<open>
       Inclusion of an RTS to the RTS of its paths.
     \<close>
 
     abbreviation incl
     where "incl \<equiv> \<lambda>t. if R.arr t then [t] else null"
 
     lemma incl_is_simulation:
     shows "simulation resid Resid incl"
       using R.con_implies_arr(1-2) con_char R.arr_resid_iff_con null_char
       by unfold_locales auto
 
     lemma incl_is_injective:
     shows "inj_on incl (Collect R.arr)"
       by (intro inj_onI) simp
 
     lemma reflects_con:
     assumes "incl t \<^sup>*\<frown>\<^sup>* incl u"
     shows "t \<frown> u"
       using assms
       by (metis (full_types) Arr.simps(1) Con_implies_Arr(1-2) Con_rec(1) null_char)
 
   end
 
   subsection "Composites of Paths"
 
   text \<open>
     The RTS of paths has composites, given by the append operation on lists.
   \<close>
 
   context paths_in_rts
   begin
 
     lemma Srcs_append [simp]:
     assumes "T \<noteq> []"
     shows "Srcs (T @ U) = Srcs T"
       by (metis Nil_is_append_conv Srcs.simps(2) Srcs.simps(3) assms hd_append list.exhaust_sel)
 
     lemma Trgs_append [simp]:
     shows "U \<noteq> [] \<Longrightarrow> Trgs (T @ U) = Trgs U"
     proof (induct T)
       show "U \<noteq> [] \<Longrightarrow> Trgs ([] @ U) = Trgs U"
         by auto
       show "\<And>t T. \<lbrakk>U \<noteq> [] \<Longrightarrow> Trgs (T @ U) = Trgs U; U \<noteq> []\<rbrakk>
                       \<Longrightarrow> Trgs ((t # T) @ U) = Trgs U"
         by (metis Nil_is_append_conv Trgs.simps(3) append_Cons list.exhaust)
     qed
 
     lemma seq_implies_Trgs_eq_Srcs:
     shows "\<lbrakk>Arr T; Arr U; Trgs T \<subseteq> Srcs U\<rbrakk> \<Longrightarrow> Trgs T = Srcs U"
       by (metis inf.orderE Arr_has_Trg seqI\<^sub>P seq_char)
 
     lemma Arr_append_iff\<^sub>P:
-    shows "\<And>U. \<lbrakk>T \<noteq> []; U \<noteq> []\<rbrakk> \<Longrightarrow> Arr (T @ U) \<longleftrightarrow> Arr T \<and> Arr U \<and> Trgs T \<subseteq> Srcs U"
-    proof (induct T)
+    shows "\<lbrakk>T \<noteq> []; U \<noteq> []\<rbrakk> \<Longrightarrow> Arr (T @ U) \<longleftrightarrow> Arr T \<and> Arr U \<and> Trgs T \<subseteq> Srcs U"
+    proof (induct T arbitrary: U)
       show "\<And>U. \<lbrakk>[] \<noteq> []; U \<noteq> []\<rbrakk> \<Longrightarrow> Arr ([] @ U) = (Arr [] \<and> Arr U \<and> Trgs [] \<subseteq> Srcs U)"
         by simp
       fix t T and U :: "'a list"
       assume ind: "\<And>U. \<lbrakk>T \<noteq> []; U \<noteq> []\<rbrakk>
                           \<Longrightarrow> Arr (T @ U) = (Arr T \<and> Arr U \<and> Trgs T \<subseteq> Srcs U)"
       assume U: "U \<noteq> []"
       show "Arr ((t # T) @ U) \<longleftrightarrow> Arr (t # T) \<and> Arr U \<and> Trgs (t # T) \<subseteq> Srcs U"
       proof (cases "T = []")
         show "T = [] \<Longrightarrow> ?thesis"
           using Arr.elims(1) U by auto
         assume T: "T \<noteq> []"
         have "Arr ((t # T) @ U) \<longleftrightarrow> Arr (t # (T @ U))"
           by simp
         also have "... \<longleftrightarrow> R.arr t \<and> Arr (T @ U) \<and> R.targets t \<subseteq> Srcs (T @ U)"
           using T U
           by (metis Arr.simps(3) Nil_is_append_conv neq_Nil_conv)
         also have "... \<longleftrightarrow> R.arr t \<and> Arr T \<and> Arr U \<and> Trgs T \<subseteq> Srcs U \<and> R.targets t \<subseteq> Srcs T"
           using T U ind by auto
         also have "... \<longleftrightarrow> Arr (t # T) \<and> Arr U \<and> Trgs (t # T) \<subseteq> Srcs U"
           using T U
           by (metis Arr.simps(3) Trgs.simps(3) neq_Nil_conv)
         finally show ?thesis by auto
       qed
     qed
 
     lemma Arr_consI\<^sub>P [intro, simp]:
     assumes "R.arr t" and "Arr U" and "R.targets t \<subseteq> Srcs U"
     shows "Arr (t # U)"
       using assms Arr.elims(3) by blast
 
     lemma Arr_appendI\<^sub>P [intro, simp]:
     assumes "Arr T" and "Arr U" and "Trgs T \<subseteq> Srcs U"
     shows "Arr (T @ U)"
       using assms
       by (metis Arr.simps(1) Arr_append_iff\<^sub>P)
 
     lemma Arr_appendE\<^sub>P [elim]:
     assumes "Arr (T @ U)" and "T \<noteq> []" and "U \<noteq> []"
     and "\<lbrakk>Arr T; Arr U; Trgs T = Srcs U\<rbrakk> \<Longrightarrow> thesis"
     shows thesis
       using assms Arr_append_iff\<^sub>P seq_implies_Trgs_eq_Srcs by force
 
     lemma Ide_append_iff\<^sub>P:
-    shows "\<And>U. \<lbrakk>T \<noteq> []; U \<noteq> []\<rbrakk> \<Longrightarrow> Ide (T @ U) \<longleftrightarrow> Ide T \<and> Ide U \<and> Trgs T \<subseteq> Srcs U"
+    shows "\<lbrakk>T \<noteq> []; U \<noteq> []\<rbrakk> \<Longrightarrow> Ide (T @ U) \<longleftrightarrow> Ide T \<and> Ide U \<and> Trgs T \<subseteq> Srcs U"
       using Ide_char by auto
 
     lemma Ide_appendI\<^sub>P [intro, simp]:
     assumes "Ide T" and "Ide U" and "Trgs T \<subseteq> Srcs U"
     shows "Ide (T @ U)"
       using assms
       by (metis Ide.simps(1) Ide_append_iff\<^sub>P)
 
     lemma Resid_append_ind:
-    shows "\<And>T U. \<lbrakk>T \<noteq> []; U \<noteq> []; V \<noteq> []\<rbrakk> \<Longrightarrow>
-                 (V @ T \<^sup>*\<frown>\<^sup>* U \<longleftrightarrow> V \<^sup>*\<frown>\<^sup>* U \<and> T \<^sup>*\<frown>\<^sup>* U \<^sup>*\\\<^sup>* V) \<and>
-                 (T \<^sup>*\<frown>\<^sup>* V @ U \<longleftrightarrow> T \<^sup>*\<frown>\<^sup>* V \<and> T \<^sup>*\\\<^sup>* V \<^sup>*\<frown>\<^sup>* U) \<and>
-                 (V @ T \<^sup>*\<frown>\<^sup>* U \<longrightarrow> (V @ T) \<^sup>*\\\<^sup>* U = V \<^sup>*\\\<^sup>* U @ T \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* V)) \<and>
-                 (T \<^sup>*\<frown>\<^sup>* V @ U \<longrightarrow> T \<^sup>*\\\<^sup>* (V @ U) = (T \<^sup>*\\\<^sup>* V) \<^sup>*\\\<^sup>* U)"
-    proof (induct V)
+    shows "\<lbrakk>T \<noteq> []; U \<noteq> []; V \<noteq> []\<rbrakk> \<Longrightarrow>
+             (V @ T \<^sup>*\<frown>\<^sup>* U \<longleftrightarrow> V \<^sup>*\<frown>\<^sup>* U \<and> T \<^sup>*\<frown>\<^sup>* U \<^sup>*\\\<^sup>* V) \<and>
+             (T \<^sup>*\<frown>\<^sup>* V @ U \<longleftrightarrow> T \<^sup>*\<frown>\<^sup>* V \<and> T \<^sup>*\\\<^sup>* V \<^sup>*\<frown>\<^sup>* U) \<and>
+             (V @ T \<^sup>*\<frown>\<^sup>* U \<longrightarrow> (V @ T) \<^sup>*\\\<^sup>* U = V \<^sup>*\\\<^sup>* U @ T \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* V)) \<and>
+             (T \<^sup>*\<frown>\<^sup>* V @ U \<longrightarrow> T \<^sup>*\\\<^sup>* (V @ U) = (T \<^sup>*\\\<^sup>* V) \<^sup>*\\\<^sup>* U)"
+    proof (induct V arbitrary: T U)
       show "\<And>T U. \<lbrakk>T \<noteq> []; U \<noteq> []; [] \<noteq> []\<rbrakk> \<Longrightarrow>
                    ([] @ T \<^sup>*\<frown>\<^sup>* U \<longleftrightarrow> [] \<^sup>*\<frown>\<^sup>* U \<and> T \<^sup>*\<frown>\<^sup>* U \<^sup>*\\\<^sup>* []) \<and>
                    (T \<^sup>*\<frown>\<^sup>* [] @ U \<longleftrightarrow> T \<^sup>*\<frown>\<^sup>* [] \<and> T \<^sup>*\\\<^sup>* [] \<^sup>*\<frown>\<^sup>* U) \<and>
                    ([] @ T \<^sup>*\<frown>\<^sup>* U \<longrightarrow> ([] @ T) \<^sup>*\\\<^sup>* U = [] \<^sup>*\\\<^sup>* U @ T \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* [])) \<and>
                    (T \<^sup>*\<frown>\<^sup>* [] @ U \<longrightarrow> T \<^sup>*\\\<^sup>* ([] @ U) = (T \<^sup>*\\\<^sup>* []) \<^sup>*\\\<^sup>* U)"
         by simp
       fix v :: 'a and T U V :: "'a list"
       assume ind: "\<And>T U. \<lbrakk>T \<noteq> []; U \<noteq> []; V \<noteq> []\<rbrakk> \<Longrightarrow>
                           (V @ T \<^sup>*\<frown>\<^sup>* U \<longleftrightarrow> V \<^sup>*\<frown>\<^sup>* U \<and> T \<^sup>*\<frown>\<^sup>* U \<^sup>*\\\<^sup>* V) \<and>
                           (T \<^sup>*\<frown>\<^sup>* V @ U \<longleftrightarrow> T \<^sup>*\<frown>\<^sup>* V \<and> T \<^sup>*\\\<^sup>* V \<^sup>*\<frown>\<^sup>* U) \<and>
                           (V @ T \<^sup>*\<frown>\<^sup>* U \<longrightarrow> (V @ T) \<^sup>*\\\<^sup>* U = V \<^sup>*\\\<^sup>* U @ T \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* V)) \<and>
                           (T \<^sup>*\<frown>\<^sup>* V @ U \<longrightarrow> T \<^sup>*\\\<^sup>* (V @ U) = (T \<^sup>*\\\<^sup>* V) \<^sup>*\\\<^sup>* U)"
       assume T: "T \<noteq> []" and U: "U \<noteq> []"
       show "((v # V) @ T \<^sup>*\<frown>\<^sup>* U \<longleftrightarrow> (v # V) \<^sup>*\<frown>\<^sup>* U \<and> T \<^sup>*\<frown>\<^sup>* U \<^sup>*\\\<^sup>* (v # V)) \<and>
             (T \<^sup>*\<frown>\<^sup>* (v # V) @ U \<longleftrightarrow> T \<^sup>*\<frown>\<^sup>* (v # V) \<and> T \<^sup>*\\\<^sup>* (v # V) \<^sup>*\<frown>\<^sup>* U) \<and>
             ((v # V) @ T \<^sup>*\<frown>\<^sup>* U \<longrightarrow>
               ((v # V) @ T) \<^sup>*\\\<^sup>* U = (v # V) \<^sup>*\\\<^sup>* U @ T \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* (v # V))) \<and>
             (T \<^sup>*\<frown>\<^sup>* (v # V) @ U \<longrightarrow> T \<^sup>*\\\<^sup>* ((v # V) @ U) = (T \<^sup>*\\\<^sup>* (v # V)) \<^sup>*\\\<^sup>* U)"
       proof (intro conjI iffI impI)
         show 1: "(v # V) @ T \<^sup>*\<frown>\<^sup>* U \<Longrightarrow>
                    ((v # V) @ T) \<^sup>*\\\<^sup>* U = (v # V) \<^sup>*\\\<^sup>* U @ T \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* (v # V))"
         proof (cases "V = []")
           show "V = [] \<Longrightarrow> (v # V) @ T \<^sup>*\<frown>\<^sup>* U \<Longrightarrow> ?thesis"
             using T U Resid_cons(1) U by auto
           assume V: "V \<noteq> []"
           assume Con: "(v # V) @ T \<^sup>*\<frown>\<^sup>* U"
           have "((v # V) @ T) \<^sup>*\\\<^sup>* U = (v # (V @ T)) \<^sup>*\\\<^sup>* U"
             by simp
           also have "... = [v] \<^sup>*\\\<^sup>* U @ (V @ T) \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* [v])"
             using T U Con Resid_cons by simp
           also have "... = [v] \<^sup>*\\\<^sup>* U @ V \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* [v]) @ T \<^sup>*\\\<^sup>* ((U \<^sup>*\\\<^sup>* [v]) \<^sup>*\\\<^sup>* V)"
             using T U V Con ind Resid_cons
             by (metis Con_sym Cons_eq_appendI append_is_Nil_conv Con_cons(1))
           also have "... = (v # V) \<^sup>*\\\<^sup>* U @ T \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* (v # V))"
             by (metis Con Con_cons(2) Cons_eq_appendI Resid_cons(1) Resid_cons(2) T U V
                 append.assoc append_is_Nil_conv Con_sym ind)
           finally show ?thesis by simp
         qed
         show 2: "T \<^sup>*\<frown>\<^sup>* (v # V) @ U \<Longrightarrow> T \<^sup>*\\\<^sup>* ((v # V) @ U) = (T \<^sup>*\\\<^sup>* (v # V)) \<^sup>*\\\<^sup>* U"
         proof (cases "V = []")
           show "V = [] \<Longrightarrow> T \<^sup>*\<frown>\<^sup>* (v # V) @ U \<Longrightarrow> ?thesis"
             using Resid_cons(2) T U by auto
           assume V: "V \<noteq> []"
           assume Con: "T \<^sup>*\<frown>\<^sup>* (v # V) @ U"
           have "T \<^sup>*\\\<^sup>* ((v # V) @ U) = T \<^sup>*\\\<^sup>* (v # (V @ U))"
             by simp
           also have 1: "... = (T \<^sup>*\\\<^sup>* [v]) \<^sup>*\\\<^sup>* (V @ U)"
             using V Con Resid_cons(2) T by force
           also have "... = ((T \<^sup>*\\\<^sup>* [v]) \<^sup>*\\\<^sup>* V) \<^sup>*\\\<^sup>* U"
             using T U V 1 Con ind
             by (metis Con_initial_right Cons_eq_appendI)
           also have "... = (T \<^sup>*\\\<^sup>* (v # V)) \<^sup>*\\\<^sup>* U"
             using T V Con
             by (metis Con_cons(2) Con_initial_right Cons_eq_appendI Resid_cons(2))
           finally show ?thesis by blast
         qed
         show "(v # V) @ T \<^sup>*\<frown>\<^sup>* U \<Longrightarrow> v # V \<^sup>*\<frown>\<^sup>* U"
           by (metis 1 Con_sym Resid.simps(1) append_Nil)
         show "(v # V) @ T \<^sup>*\<frown>\<^sup>* U \<Longrightarrow> T \<^sup>*\<frown>\<^sup>* U \<^sup>*\\\<^sup>* (v # V)"
           using T U Con_sym
           by (metis 1 Con_initial_right Resid_cons(1-2) append.simps(2) ind self_append_conv)
         show "T \<^sup>*\<frown>\<^sup>* (v # V) @ U \<Longrightarrow> T \<^sup>*\<frown>\<^sup>* v # V"
           using 2 by fastforce
         show "T \<^sup>*\<frown>\<^sup>* (v # V) @ U \<Longrightarrow> T \<^sup>*\\\<^sup>* (v # V) \<^sup>*\<frown>\<^sup>* U"
           using 2 by fastforce
         show "T \<^sup>*\<frown>\<^sup>* v # V \<and> T \<^sup>*\\\<^sup>* (v # V) \<^sup>*\<frown>\<^sup>* U \<Longrightarrow> T \<^sup>*\<frown>\<^sup>* (v # V) @ U"
         proof -
           assume Con: "T \<^sup>*\<frown>\<^sup>* v # V \<and> T \<^sup>*\\\<^sup>* (v # V) \<^sup>*\<frown>\<^sup>* U"
           have "T \<^sup>*\<frown>\<^sup>* (v # V) @ U \<longleftrightarrow> T \<^sup>*\<frown>\<^sup>* v # (V @ U)"
             by simp
           also have "... \<longleftrightarrow> T \<^sup>*\<frown>\<^sup>* [v] \<and> T \<^sup>*\\\<^sup>* [v] \<^sup>*\<frown>\<^sup>* V @ U"
             using T U Con_cons(2) by simp
           also have "... \<longleftrightarrow> T \<^sup>*\\\<^sup>* [v] \<^sup>*\<frown>\<^sup>* V @ U"
             by fastforce
           also have "... \<longleftrightarrow> True"
             using Con ind
             by (metis Con_cons(2) Resid_cons(2) T U self_append_conv2)
           finally show ?thesis by blast
         qed
         show "v # V \<^sup>*\<frown>\<^sup>* U \<and> T \<^sup>*\<frown>\<^sup>* U \<^sup>*\\\<^sup>* (v # V) \<Longrightarrow> (v # V) @ T \<^sup>*\<frown>\<^sup>* U"
         proof -
           assume Con: "v # V \<^sup>*\<frown>\<^sup>* U \<and> T \<^sup>*\<frown>\<^sup>* U \<^sup>*\\\<^sup>* (v # V)"
           have "(v # V) @ T \<^sup>*\<frown>\<^sup>* U \<longleftrightarrow>v # (V @ T) \<^sup>*\<frown>\<^sup>* U"
             by simp
           also have "... \<longleftrightarrow> [v] \<^sup>*\<frown>\<^sup>* U \<and> V @ T \<^sup>*\<frown>\<^sup>* U \<^sup>*\\\<^sup>* [v]"
             using T U Con_cons(1) by simp
           also have "... \<longleftrightarrow> V @ T \<^sup>*\<frown>\<^sup>* U \<^sup>*\\\<^sup>* [v]"
             by (metis Con Con_cons(1) U)
           also have "... \<longleftrightarrow> True"
             using Con ind
             by (metis Con_cons(1) Con_sym Resid_cons(2) T U append_self_conv2)
           finally show ?thesis by blast
         qed
       qed
     qed
 
     lemma Con_append:
     assumes "T \<noteq> []" and "U \<noteq> []" and "V \<noteq> []"
     shows "T @ U \<^sup>*\<frown>\<^sup>* V \<longleftrightarrow> T \<^sup>*\<frown>\<^sup>* V \<and> U \<^sup>*\<frown>\<^sup>* V \<^sup>*\\\<^sup>* T"
     and "T \<^sup>*\<frown>\<^sup>* U @ V \<longleftrightarrow> T \<^sup>*\<frown>\<^sup>* U \<and> T \<^sup>*\\\<^sup>* U \<^sup>*\<frown>\<^sup>* V"
       using assms Resid_append_ind by blast+
 
     lemma Con_appendI [intro]:
     shows "\<lbrakk>T \<^sup>*\<frown>\<^sup>* V; U \<^sup>*\<frown>\<^sup>* V \<^sup>*\\\<^sup>* T\<rbrakk> \<Longrightarrow> T @ U \<^sup>*\<frown>\<^sup>* V"
     and "\<lbrakk>T \<^sup>*\<frown>\<^sup>* U; T \<^sup>*\\\<^sup>* U \<^sup>*\<frown>\<^sup>* V\<rbrakk> \<Longrightarrow> T \<^sup>*\<frown>\<^sup>* U @ V"
       by (metis Con_append(1) Con_sym Resid.simps(1))+
 
     lemma Resid_append [intro, simp]:
     shows "\<lbrakk>T \<noteq> []; T @ U \<^sup>*\<frown>\<^sup>* V\<rbrakk> \<Longrightarrow> (T @ U) \<^sup>*\\\<^sup>* V = (T \<^sup>*\\\<^sup>* V) @ (U \<^sup>*\\\<^sup>* (V \<^sup>*\\\<^sup>* T))"
     and "\<lbrakk>U \<noteq> []; V \<noteq> []; T \<^sup>*\<frown>\<^sup>* U @ V\<rbrakk> \<Longrightarrow> T \<^sup>*\\\<^sup>* (U @ V) = (T \<^sup>*\\\<^sup>* U) \<^sup>*\\\<^sup>* V"
       using Resid_append_ind
        apply (metis Con_sym Resid.simps(1) append_self_conv)
       using Resid_append_ind
       by (metis Resid.simps(1))
 
     lemma Resid_append2 [simp]:
     assumes "T \<noteq> []" and "U \<noteq> []" and "V \<noteq> []" and "W \<noteq> []"
     and "T @ U \<^sup>*\<frown>\<^sup>* V @ W"
     shows "(T @ U) \<^sup>*\\\<^sup>* (V @ W) =
            (T \<^sup>*\\\<^sup>* V) \<^sup>*\\\<^sup>* W @ (U \<^sup>*\\\<^sup>* (V \<^sup>*\\\<^sup>* T)) \<^sup>*\\\<^sup>* (W \<^sup>*\\\<^sup>* (T \<^sup>*\\\<^sup>* V))"
       using assms Resid_append
       by (metis Con_append(1-2) append_is_Nil_conv)
 
     lemma append_is_composite_of:
     assumes "seq T U"
     shows "composite_of T U (T @ U)"
       unfolding composite_of_def
       using assms
       apply (intro conjI)
         apply (metis Arr.simps(1) Resid_Arr_self Resid_Ide_Arr_ind Arr_appendI\<^sub>P
                      Resid_append_ind ide_char order_refl seq_char)
        apply (metis Arr.simps(1) Arr_appendI\<^sub>P Con_Arr_self Resid_Arr_self Resid_append_ind
                     ide_char seq_char order_refl)
       by (metis Arr.simps(1) Con_Arr_self Con_append(1) Resid_Arr_self Arr_appendI\<^sub>P
                 Ide_append_iff\<^sub>P Resid_append(1) ide_char seq_char order_refl)
 
     sublocale rts_with_composites Resid
       using append_is_composite_of composable_def by unfold_locales blast
 
     theorem is_rts_with_composites:
     shows "rts_with_composites Resid"
       ..
 
     (* TODO: This stuff might be redundant. *)
     lemma arr_append [intro, simp]:
     assumes "seq T U"
     shows "arr (T @ U)"
       using assms arrI\<^sub>P seq_char by simp
 
     lemma arr_append_imp_seq:
     assumes "T \<noteq> []" and "U \<noteq> []" and "arr (T @ U)"
     shows "seq T U"
       using assms arr_char seq_char Arr_append_iff\<^sub>P seq_implies_Trgs_eq_Srcs by simp
 
     lemma sources_append [simp]:
     assumes "seq T U"
     shows "sources (T @ U) = sources T"
       using assms
       by (meson append_is_composite_of sources_composite_of)
 
     lemma targets_append [simp]:
     assumes "seq T U"
     shows "targets (T @ U) = targets U"
       using assms
       by (meson append_is_composite_of targets_composite_of)
 
     lemma cong_respects_seq\<^sub>P:
     assumes "seq T U" and "T \<^sup>*\<sim>\<^sup>* T'" and "U \<^sup>*\<sim>\<^sup>* U'"
     shows "seq T' U'"
       by (meson assms cong_respects_seq)
 
     lemma cong_append [intro]:
     assumes "seq T U" and "T \<^sup>*\<sim>\<^sup>* T'" and "U \<^sup>*\<sim>\<^sup>* U'"
     shows "T @ U \<^sup>*\<sim>\<^sup>* T' @ U'"
     proof
       have 1: "\<And>T U T' U'. \<lbrakk>seq T U; T \<^sup>*\<sim>\<^sup>* T'; U \<^sup>*\<sim>\<^sup>* U'\<rbrakk> \<Longrightarrow> seq T' U'"
         using assms cong_respects_seq\<^sub>P by simp
       have 2: "\<And>T U T' U'. \<lbrakk>seq T U; T \<^sup>*\<sim>\<^sup>* T'; U \<^sup>*\<sim>\<^sup>* U'\<rbrakk> \<Longrightarrow> T @ U \<^sup>*\<lesssim>\<^sup>* T' @ U'"
       proof -
         fix T U T' U'
         assume TU: "seq T U" and TT': "T \<^sup>*\<sim>\<^sup>* T'" and UU': "U \<^sup>*\<sim>\<^sup>* U'"
         have T'U': "seq T' U'"
           using TU TT' UU' cong_respects_seq\<^sub>P by simp
         have 3: "Ide (T \<^sup>*\\\<^sup>* T') \<and> Ide (T' \<^sup>*\\\<^sup>* T) \<and> Ide (U \<^sup>*\\\<^sup>* U') \<and> Ide (U' \<^sup>*\\\<^sup>* U)"
           using TU TT' UU' ide_char by blast
         have "(T @ U) \<^sup>*\\\<^sup>* (T' @ U') =
               ((T \<^sup>*\\\<^sup>* T') \<^sup>*\\\<^sup>* U') @ U \<^sup>*\\\<^sup>* ((T' \<^sup>*\\\<^sup>* T) @ U' \<^sup>*\\\<^sup>* (T \<^sup>*\\\<^sup>* T'))"
         proof -
           have 4: "T \<noteq> [] \<and> U \<noteq> [] \<and> T' \<noteq> [] \<and> U' \<noteq> []"
             using TU TT' UU' Arr.simps(1) seq_char ide_char by auto
           moreover have "(T @ U) \<^sup>*\\\<^sup>* (T' @ U') \<noteq> []"
           proof (intro Con_appendI)
             show "T \<^sup>*\\\<^sup>* T' \<noteq> []"
               using "3" by force
             show "(T \<^sup>*\\\<^sup>* T') \<^sup>*\\\<^sup>* U' \<noteq> []"
               using "3" T'U' \<open>T \<^sup>*\\<^sup>* T' \<noteq> []\<close> Con_Ide_iff seq_char by fastforce
             show "U \<^sup>*\\\<^sup>* ((T' @ U') \<^sup>*\\\<^sup>* T) \<noteq> []"
             proof -
               have "U \<^sup>*\\\<^sup>* ((T' @ U') \<^sup>*\\\<^sup>* T) = U \<^sup>*\\\<^sup>* ((T' \<^sup>*\\\<^sup>* T) @ U' \<^sup>*\\\<^sup>* (T \<^sup>*\\\<^sup>* T'))"
                 by (metis Con_appendI(1) Resid_append(1) \<open>(T \<^sup>*\\<^sup>* T') \<^sup>*\\<^sup>* U' \<noteq> []\<close>
                     \<open>T \<^sup>*\\<^sup>* T' \<noteq> []\<close> calculation Con_sym)
               also have "... = (U \<^sup>*\\\<^sup>* (T' \<^sup>*\\\<^sup>* T)) \<^sup>*\\\<^sup>* (U' \<^sup>*\\\<^sup>* (T \<^sup>*\\\<^sup>* T'))"
                 by (metis Arr.simps(1) Con_append(2) Resid_append(2) \<open>(T \<^sup>*\\<^sup>* T') \<^sup>*\\<^sup>* U' \<noteq> []\<close>
                     Con_implies_Arr(1) Con_sym)
               also have "... = U \<^sup>*\\\<^sup>* U'"
                 by (metis (mono_tags, lifting) "3" Ide.simps(1) Resid_Ide(1) Srcs_Resid TU
                     \<open>(T \<^sup>*\\<^sup>* T') \<^sup>*\\<^sup>* U' \<noteq> []\<close> Con_Ide_iff seq_char)
               finally show ?thesis
                 using 3 UU' by force
             qed
           qed
           ultimately show ?thesis
             using Resid_append2 [of T U T' U'] seq_char
             by (metis Con_append(2) Con_sym Resid_append(2) Resid.simps(1))
         qed
         moreover have "Ide ..."
         proof
           have 3: "Ide (T \<^sup>*\\\<^sup>* T') \<and> Ide (T' \<^sup>*\\\<^sup>* T) \<and> Ide (U \<^sup>*\\\<^sup>* U') \<and> Ide (U' \<^sup>*\\\<^sup>* U)"
             using TU TT' UU' ide_char by blast
           show 4: "Ide ((T \<^sup>*\\\<^sup>* T') \<^sup>*\\\<^sup>* U')"
             using TU T'U' TT' UU' 1 3
             by (metis (full_types) Srcs_Resid Con_Ide_iff Resid_Ide_Arr_ind seq_char)
           show 5: "Ide (U \<^sup>*\\\<^sup>* ((T' \<^sup>*\\\<^sup>* T) @ U' \<^sup>*\\\<^sup>* (T \<^sup>*\\\<^sup>* T')))"
           proof -
             have "U \<^sup>*\\\<^sup>* (T' \<^sup>*\\\<^sup>* T) = U"
               by (metis (full_types) "3" TT' TU Con_Ide_iff Resid_Ide(1) Srcs_Resid
                   con_char seq_char prfx_implies_con)
             moreover have "U' \<^sup>*\\\<^sup>* (T \<^sup>*\\\<^sup>* T') = U'"
               by (metis "3" "4" Ide.simps(1) Resid_Ide(1))
             ultimately show ?thesis
               by (metis "3" "4" Arr.simps(1) Con_append(2) Ide.simps(1) Resid_append(2)
                   TU Con_sym seq_char)
           qed
           show "Trgs ((T \<^sup>*\\\<^sup>* T') \<^sup>*\\\<^sup>* U') \<subseteq> Srcs (U \<^sup>*\\\<^sup>* (T' \<^sup>*\\\<^sup>* T @ U' \<^sup>*\\\<^sup>* (T \<^sup>*\\\<^sup>* T')))"
             by (metis 4 5 Arr_append_iff\<^sub>P Ide.simps(1) Nil_is_append_conv
                 calculation Con_imp_Arr_Resid)
         qed
         ultimately show "T @ U \<^sup>*\<lesssim>\<^sup>* T' @ U'"
           using ide_char by presburger
       qed
       show "T @ U \<^sup>*\<lesssim>\<^sup>* T' @ U'"
         using assms 2 by simp
       show "T' @ U' \<^sup>*\<lesssim>\<^sup>* T @ U"
         using assms 1 2 cong_symmetric by blast
     qed
 
     lemma cong_cons [intro]:
     assumes "seq [t] U" and "t \<sim> t'" and "U \<^sup>*\<sim>\<^sup>* U'"
     shows "t # U \<^sup>*\<sim>\<^sup>* t' # U'"
       using assms cong_append [of "[t]" U "[t']" U']
       by (simp add: R.prfx_implies_con ide_char)
 
     lemma cong_append_ideI [intro]:
     assumes "seq T U"
     shows "ide T \<Longrightarrow> T @ U \<^sup>*\<sim>\<^sup>* U" and "ide U \<Longrightarrow> T @ U \<^sup>*\<sim>\<^sup>* T"
     and "ide T \<Longrightarrow> U \<^sup>*\<sim>\<^sup>* T @ U" and "ide U \<Longrightarrow> T \<^sup>*\<sim>\<^sup>* T @ U"
     proof -
       show 1: "ide T \<Longrightarrow> T @ U \<^sup>*\<sim>\<^sup>* U"
         using assms
         by (metis append_is_composite_of composite_ofE resid_arr_ide prfx_implies_con
             con_sym)
       show 2: "ide U \<Longrightarrow> T @ U \<^sup>*\<sim>\<^sup>* T"
         by (meson assms append_is_composite_of composite_ofE ide_backward_stable)
       show "ide T \<Longrightarrow> U \<^sup>*\<sim>\<^sup>* T @ U"
         using 1 cong_symmetric by auto
       show "ide U \<Longrightarrow> T \<^sup>*\<sim>\<^sup>* T @ U"
         using 2 cong_symmetric by auto
     qed
 
     lemma cong_cons_ideI [intro]:
     assumes "seq [t] U" and "R.ide t"
     shows "t # U \<^sup>*\<sim>\<^sup>* U" and "U \<^sup>*\<sim>\<^sup>* t # U"
       using assms cong_append_ideI [of "[t]" U]
       by (auto simp add: ide_char)
 
     lemma prfx_decomp:
     assumes "[t] \<^sup>*\<lesssim>\<^sup>* [u]"
     shows "[t] @ [u \\ t] \<^sup>*\<sim>\<^sup>* [u]"
     proof
       (* TODO: I really want these to be doable by auto. *)
       show 1: "[u] \<^sup>*\<lesssim>\<^sup>* [t] @ [u \\ t]"
         using assms
         by (metis Con_imp_Arr_Resid Con_rec(3) Resid.simps(3) Resid_rec(3) R.con_sym
             append.left_neutral append_Cons arr_char cong_reflexive list.distinct(1))
       show "[t] @ [u \\ t] \<^sup>*\<lesssim>\<^sup>* [u]"
       proof -
         have "([t] @ [u \\ t]) \<^sup>*\\\<^sup>* [u] = ([t] \<^sup>*\\\<^sup>* [u]) @ ([u \\ t] \<^sup>*\\\<^sup>* [u \\ t])"
           using assms
           by (metis Arr_Resid_single Con_Arr_self Con_appendI(1) Con_sym Resid_append(1)
               Resid_rec(1) con_char list.discI prfx_implies_con)
         moreover have "Ide ..."
           using assms
           by (metis 1 Con_sym append_Nil2 arr_append_imp_seq calculation cong_append_ideI(4)
               ide_backward_stable Con_implies_Arr(2) Resid_Arr_self con_char ide_char
               prfx_implies_con arr_resid_iff_con)
         ultimately show ?thesis
           using ide_char by presburger
       qed
     qed
 
     lemma composite_of_single_single:
     assumes "R.composite_of t u v"
     shows "composite_of [t] [u] ([t] @ [u])"
     proof
       show "[t] \<^sup>*\<lesssim>\<^sup>* [t] @ [u]"
       proof -
         have "[t] \<^sup>*\\\<^sup>* ([t] @ [u]) = ([t] \<^sup>*\\\<^sup>* [t]) \<^sup>*\\\<^sup>* [u]"
           using assms by auto
         moreover have "Ide ..."
           by (metis (no_types, lifting) Con_implies_Arr(2) R.bounded_imp_con
               R.con_composite_of_iff R.con_prfx_composite_of(1) assms resid_ide_arr
               Con_rec(1) Resid.simps(3) Resid_Arr_self con_char ide_char)
         ultimately show ?thesis
           using ide_char by presburger
       qed
       show "([t] @ [u]) \<^sup>*\\\<^sup>* [t] \<^sup>*\<sim>\<^sup>* [u]"
         using assms
         by (metis \<open>prfx [t] ([t] @ [u])\<close> append_is_composite_of arr_append_imp_seq
             composite_ofE con_def not_Cons_self2 Con_implies_Arr(2) arr_char null_char
             prfx_implies_con)
     qed
 
   end
 
   subsection "Paths in a Weakly Extensional RTS"
 
   locale paths_in_weakly_extensional_rts =
     R: weakly_extensional_rts +
     paths_in_rts
   begin
 
     lemma ex_un_Src:
     assumes "Arr T"
     shows "\<exists>!a. a \<in> Srcs T"
       using assms
       by (simp add: R.weakly_extensional_rts_axioms Srcs_simp\<^sub>P R.arr_has_un_source)
 
     fun Src
     where "Src T = R.src (hd T)"
 
     lemma Srcs_simp\<^sub>P\<^sub>W\<^sub>E:
     assumes "Arr T"
     shows "Srcs T = {Src T}"
     proof -
       have "[R.src (hd T)] \<in> sources T"
         by (metis Arr_imp_arr_hd Con_single_ide_ind Ide.simps(2) Srcs_simp\<^sub>P assms
                   con_char ide_char in_sourcesI con_sym R.ide_src R.src_in_sources)
       hence "R.src (hd T) \<in> Srcs T"
         using assms
         by (metis Srcs.elims Arr_has_Src list.sel(1) R.arr_iff_has_source R.src_in_sources)
       thus ?thesis
         using assms ex_un_Src by auto
     qed
 
     lemma ex_un_Trg:
     assumes "Arr T"
     shows "\<exists>!b. b \<in> Trgs T"
       using assms
       apply (induct T)
        apply auto[1]
       by (metis Con_Arr_self Ide_implies_Arr Resid_Arr_self Srcs_Resid ex_un_Src)
 
     fun Trg
     where "Trg [] = R.null"
         | "Trg [t] = R.trg t"
         | "Trg (t # T) = Trg T"
 
     lemma Trg_simp [simp]:
     shows "T \<noteq> [] \<Longrightarrow> Trg T = R.trg (last T)"
       apply (induct T)
        apply auto
       by (metis Trg.simps(3) list.exhaust_sel)
 
     lemma Trgs_simp\<^sub>P\<^sub>W\<^sub>E [simp]:
     assumes "Arr T"
     shows "Trgs T = {Trg T}"
       using assms
       by (metis Arr_imp_arr_last Con_Arr_self Con_imp_Arr_Resid R.trg_in_targets
           Srcs.simps(1) Srcs_Resid Srcs_simp\<^sub>P\<^sub>W\<^sub>E Trg_simp insertE insert_absorb insert_not_empty
           Trgs_simp\<^sub>P)
 
     lemma Src_resid [simp]:
     assumes "T \<^sup>*\<frown>\<^sup>* U"
     shows "Src (T \<^sup>*\\\<^sup>* U) = Trg U"
       using assms Con_imp_Arr_Resid Con_implies_Arr(2) Srcs_Resid Srcs_simp\<^sub>P\<^sub>W\<^sub>E by force
 
     lemma Trg_resid_sym:
     assumes "T \<^sup>*\<frown>\<^sup>* U"
     shows "Trg (T \<^sup>*\\\<^sup>* U) = Trg (U \<^sup>*\\\<^sup>* T)"
       using assms Con_imp_Arr_Resid Con_sym Trgs_Resid_sym by auto
 
     lemma Src_append [simp]:
     assumes "seq T U"
     shows "Src (T @ U) = Src T"
       using assms
       by (metis Arr.simps(1) Src.simps hd_append seq_char)
 
     lemma Trg_append [simp]:
     assumes "seq T U"
     shows "Trg (T @ U) = Trg U"
       using assms
       by (metis Ide.simps(1) Resid.simps(1) Trg_simp append_is_Nil_conv ide_char ide_trg
           last_appendR seqE trg_def)
 
     lemma Arr_append_iff\<^sub>P\<^sub>W\<^sub>E:
     assumes "T \<noteq> []" and "U \<noteq> []"
     shows "Arr (T @ U) \<longleftrightarrow> Arr T \<and> Arr U \<and> Trg T = Src U"
       using assms Arr_appendE\<^sub>P Srcs_simp\<^sub>P\<^sub>W\<^sub>E by auto
 
     lemma Arr_consI\<^sub>P\<^sub>W\<^sub>E [intro, simp]:
     assumes "R.arr t" and "Arr U" and "R.trg t = Src U"
     shows "Arr (t # U)"
       using assms
       by (metis Arr.simps(2) Srcs_simp\<^sub>P\<^sub>W\<^sub>E Trg.simps(2) Trgs.simps(2) Trgs_simp\<^sub>P\<^sub>W\<^sub>E
           dual_order.eq_iff Arr_consI\<^sub>P)
 
     lemma Arr_consE [elim]:
     assumes "Arr (t # U)"
     and "\<lbrakk>R.arr t; U \<noteq> [] \<Longrightarrow> Arr U; U \<noteq> [] \<Longrightarrow> R.trg t = Src U\<rbrakk> \<Longrightarrow> thesis"
     shows thesis
       using assms
       by (metis Arr_append_iff\<^sub>P\<^sub>W\<^sub>E Trg.simps(2) append_Cons append_Nil list.distinct(1)
           Arr.simps(2))
 
     lemma Arr_appendI\<^sub>P\<^sub>W\<^sub>E [intro, simp]:
     assumes "Arr T" and "Arr U" and "Trg T = Src U"
     shows "Arr (T @ U)"
       using assms
       by (metis Arr.simps(1) Arr_append_iff\<^sub>P\<^sub>W\<^sub>E)
 
     lemma Arr_appendE\<^sub>P\<^sub>W\<^sub>E [elim]:
     assumes "Arr (T @ U)" and "T \<noteq> []" and "U \<noteq> []"
     and "\<lbrakk>Arr T; Arr U; Trg T = Src U\<rbrakk> \<Longrightarrow> thesis"
     shows thesis
       using assms Arr_append_iff\<^sub>P\<^sub>W\<^sub>E seq_implies_Trgs_eq_Srcs by force
 
     lemma Ide_append_iff\<^sub>P\<^sub>W\<^sub>E:
     assumes "T \<noteq> []" and "U \<noteq> []"
     shows "Ide (T @ U) \<longleftrightarrow> Ide T \<and> Ide U \<and> Trg T = Src U"
       using assms Ide_char by auto
 
     lemma Ide_appendI\<^sub>P\<^sub>W\<^sub>E [intro, simp]:
     assumes "Ide T" and "Ide U" and "Trg T = Src U"
     shows "Ide (T @ U)"
       using assms
       by (metis Ide.simps(1) Ide_append_iff\<^sub>P\<^sub>W\<^sub>E)
 
     lemma Ide_appendE [elim]:
     assumes "Ide (T @ U)" and "T \<noteq> []" and "U \<noteq> []"
     and "\<lbrakk>Ide T; Ide U; Trg T = Src U\<rbrakk> \<Longrightarrow> thesis"
     shows thesis
       using assms Ide_append_iff\<^sub>P\<^sub>W\<^sub>E by metis
 
     lemma Ide_consI [intro, simp]:
     assumes "R.ide t" and "Ide U" and "R.trg t = Src U"
     shows "Ide (t # U)"
       using assms
       by (simp add: Ide_char)
 
     lemma Ide_consE [elim]:
     assumes "Ide (t # U)"
     and "\<lbrakk>R.ide t; U \<noteq> [] \<Longrightarrow> Ide U; U \<noteq> [] \<Longrightarrow> R.trg t = Src U\<rbrakk> \<Longrightarrow> thesis"
     shows thesis
       using assms
       by (metis Con_rec(4) Ide.simps(2) Ide_imp_Ide_hd Ide_imp_Ide_tl R.trg_def R.trg_ide
           Resid_Arr_Ide_ind Trg.simps(2) ide_char list.sel(1) list.sel(3) list.simps(3)
           Src_resid ide_def)
 
     lemma Ide_imp_Src_eq_Trg:
     assumes "Ide T"
     shows "Src T = Trg T"
       using assms
       by (metis Ide.simps(1) Src_resid ide_char ide_def)
 
   end
 
   subsection "Paths in a Confluent RTS"
 
   text \<open>
     Here we show that confluence of an RTS extends to  confluence of the RTS of its paths.
   \<close>
 
   locale paths_in_confluent_rts =
     paths_in_rts +
     R: confluent_rts
   begin
 
     lemma confluence_single:
     assumes "\<And>t u. R.coinitial t u \<Longrightarrow> t \<frown> u"
-    shows "\<And>t. \<lbrakk>R.arr t; Arr U; R.sources t = Srcs U\<rbrakk> \<Longrightarrow> [t] \<^sup>*\<frown>\<^sup>* U"
-    proof (induct U)
+    shows "\<lbrakk>R.arr t; Arr U; R.sources t = Srcs U\<rbrakk> \<Longrightarrow> [t] \<^sup>*\<frown>\<^sup>* U"
+    proof (induct U arbitrary: t)
       show "\<And>t. \<lbrakk>R.arr t; Arr []; R.sources t = Srcs []\<rbrakk> \<Longrightarrow> [t] \<^sup>*\<frown>\<^sup>* []"
         by simp
       fix t u U
       assume ind: "\<And>t. \<lbrakk>R.arr t; Arr U; R.sources t = Srcs U\<rbrakk> \<Longrightarrow> [t] \<^sup>*\<frown>\<^sup>* U"
       assume t: "R.arr t"
       assume uU: "Arr (u # U)"
       assume coinitial: "R.sources t = Srcs (u # U)"
       hence 1: "R.coinitial t u"
         using t uU
         by (metis Arr.simps(2) Con_implies_Arr(1) Con_imp_eq_Srcs Con_initial_left
             Srcs.simps(2) Con_Arr_self R.coinitial_iff)
       show "[t] \<^sup>*\<frown>\<^sup>* u # U"
       proof (cases "U = []")
         show "U = [] \<Longrightarrow> ?thesis"
           using assms t uU coinitial R.coinitial_iff by fastforce
         assume U: "U \<noteq> []"
         show ?thesis
         proof -
           have 2: "Arr [t \\ u] \<and> Arr U \<and> Srcs [t \\ u] = Srcs U"
             using assms 1 t uU U R.arr_resid_iff_con
             apply (intro conjI)
               apply simp
              apply (metis Con_Arr_self Con_implies_Arr(2) Resid_cons(2))
             by (metis (full_types) Con_cons(2) Srcs.simps(2) Srcs_Resid Trgs.simps(2)
                 Con_Arr_self Con_imp_eq_Srcs list.simps(3) R.sources_resid)
           have "[t] \<^sup>*\<frown>\<^sup>* u # U \<longleftrightarrow> t \<frown> u \<and> [t \\ u] \<^sup>*\<frown>\<^sup>* U"
             using U Con_rec(3) [of U t u] by simp
           also have "... \<longleftrightarrow> True"
             using assms t uU U 1 2 ind by force
           finally show ?thesis by blast
         qed
       qed
     qed
 
     lemma confluence_ind:
-    shows "\<And>U. \<lbrakk>Arr T; Arr U; Srcs T = Srcs U\<rbrakk> \<Longrightarrow> T \<^sup>*\<frown>\<^sup>* U"
-    proof (induct T)
+    shows "\<lbrakk>Arr T; Arr U; Srcs T = Srcs U\<rbrakk> \<Longrightarrow> T \<^sup>*\<frown>\<^sup>* U"
+    proof (induct T arbitrary: U)
       show "\<And>U. \<lbrakk>Arr []; Arr U; Srcs [] = Srcs U\<rbrakk> \<Longrightarrow> [] \<^sup>*\<frown>\<^sup>* U"
         by simp
       fix t T U
       assume ind: "\<And>U. \<lbrakk>Arr T; Arr U; Srcs T = Srcs U\<rbrakk> \<Longrightarrow> T \<^sup>*\<frown>\<^sup>* U"
       assume tT: "Arr (t # T)"
       assume U: "Arr U"
       assume coinitial: "Srcs (t # T) = Srcs U"
       show "t # T \<^sup>*\<frown>\<^sup>* U"
       proof (cases "T = []")
         show "T = [] \<Longrightarrow> ?thesis"
           using U tT coinitial confluence_single [of t U] R.confluence by simp
         assume T: "T \<noteq> []"
         show ?thesis
         proof -
           have 1: "[t] \<^sup>*\<frown>\<^sup>* U"
             using tT U coinitial R.confluence
             by (metis R.arr_def Srcs.simps(2) T Con_Arr_self Con_imp_eq_Srcs
                 Con_initial_right Con_rec(4) confluence_single)
           moreover have "T \<^sup>*\<frown>\<^sup>* U \<^sup>*\\\<^sup>* [t]"
             using 1 tT U T coinitial ind [of "U \<^sup>*\\\<^sup>* [t]"]
             by (metis (full_types) Con_imp_Arr_Resid Arr_iff_Con_self Con_implies_Arr(2)
                 Con_imp_eq_Srcs Con_sym R.sources_resid Srcs.simps(2) Srcs_Resid
                 Trgs.simps(2) Con_rec(4))
           ultimately show ?thesis
             using Con_cons(1) [of T U t] by fastforce
         qed
       qed
     qed
 
     lemma confluence\<^sub>P:
     assumes "coinitial T U"
     shows "con T U"
       using assms confluence_ind sources_char\<^sub>P coinitial_def con_char by auto
 
     sublocale confluent_rts Resid
       apply (unfold_locales)
       using confluence\<^sub>P by simp
 
     lemma is_confluent_rts:
     shows "confluent_rts Resid"
       ..
 
   end
 
   subsection "Simulations Lift to Paths"
 
   text \<open>
     In this section we show that a simulation from RTS \<open>A\<close> to RTS \<open>B\<close> determines a simulation
     from the RTS of paths in \<open>A\<close> to the RTS of paths in \<open>B\<close>.  In other words, the path-RTS
     construction is functorial with respect to simulation.
   \<close>
 
   context simulation
   begin
 
     interpretation P\<^sub>A: paths_in_rts A
       ..
     interpretation P\<^sub>B: paths_in_rts B
       ..
 
     lemma map_Resid_single:
-    shows "\<And>u. P\<^sub>A.con T [u] \<Longrightarrow> map F (P\<^sub>A.Resid T [u]) = P\<^sub>B.Resid (map F T) [F u]"
-      apply (induct T)
+    shows "P\<^sub>A.con T [u] \<Longrightarrow> map F (P\<^sub>A.Resid T [u]) = P\<^sub>B.Resid (map F T) [F u]"
+      apply (induct T arbitrary: u)
        apply simp
     proof -
       fix t u T
       assume ind: "\<And>u. P\<^sub>A.con T [u] \<Longrightarrow> map F (P\<^sub>A.Resid T [u]) = P\<^sub>B.Resid (map F T) [F u]"
       assume 1: "P\<^sub>A.con (t # T) [u]"
       show "map F (P\<^sub>A.Resid (t # T) [u]) = P\<^sub>B.Resid (map F (t # T)) [F u]"
       proof (cases "T = []")
         show "T = [] \<Longrightarrow> ?thesis"
           using "1" P\<^sub>A.null_char by fastforce
         assume T: "T \<noteq> []"
         show ?thesis
           using T 1 ind P\<^sub>A.con_def P\<^sub>A.null_char P\<^sub>A.Con_rec(2) P\<^sub>A.Resid_rec(2) P\<^sub>B.Con_rec(2)
                 P\<^sub>B.Resid_rec(2)
           apply simp
           by (metis A.con_sym Nil_is_map_conv preserves_con preserves_resid)
       qed
     qed
 
     lemma map_Resid:
-    shows "\<And>T. P\<^sub>A.con T U \<Longrightarrow> map F (P\<^sub>A.Resid T U) = P\<^sub>B.Resid (map F T) (map F U)"
-      apply (induct U)
+    shows "P\<^sub>A.con T U \<Longrightarrow> map F (P\<^sub>A.Resid T U) = P\<^sub>B.Resid (map F T) (map F U)"
+      apply (induct U arbitrary: T)
       using P\<^sub>A.Resid.simps(1) P\<^sub>A.con_char P\<^sub>A.con_sym
        apply blast
     proof -
       fix u U T
       assume ind: "\<And>T. P\<^sub>A.con T U \<Longrightarrow>
                           map F (P\<^sub>A.Resid T U) = P\<^sub>B.Resid (map F T) (map F U)"
       assume 1: "P\<^sub>A.con T (u # U)"
       show "map F (P\<^sub>A.Resid T (u # U)) = P\<^sub>B.Resid (map F T) (map F (u # U))"
       proof (cases "U = []")
         show "U = [] \<Longrightarrow> ?thesis"
           using "1" map_Resid_single by force
         assume U: "U \<noteq> []"
         have "P\<^sub>B.Resid (map F T) (map F (u # U)) =
               P\<^sub>B.Resid (P\<^sub>B.Resid (map F T) [F u]) (map F U)"
           using U 1 P\<^sub>B.Resid_cons(2)
           apply simp
           by (metis P\<^sub>B.Arr.simps(1) P\<^sub>B.Con_consI(2) P\<^sub>B.Con_implies_Arr(1) list.map_disc_iff)
         also have "... = map F (P\<^sub>A.Resid (P\<^sub>A.Resid T [u]) U)"
           using U 1 ind
           by (metis P\<^sub>A.Con_initial_right P\<^sub>A.Resid_cons(2) P\<^sub>A.con_char map_Resid_single)
         also have "... = map F (P\<^sub>A.Resid T (u # U))"
           using "1" P\<^sub>A.Resid_cons(2) P\<^sub>A.con_char U by auto
         finally show ?thesis by simp
       qed
     qed
 
     lemma preserves_paths:
     shows "P\<^sub>A.Arr T \<Longrightarrow> P\<^sub>B.Arr (map F T)"
       by (metis P\<^sub>A.Con_Arr_self P\<^sub>A.conI\<^sub>P P\<^sub>B.Arr_iff_Con_self map_Resid map_is_Nil_conv)
 
     interpretation Fx: simulation P\<^sub>A.Resid P\<^sub>B.Resid \<open>\<lambda>T. if P\<^sub>A.Arr T then map F T else []\<close>
     proof
       let ?Fx = "\<lambda>T. if P\<^sub>A.Arr T then map F T else []"
       show "\<And>T. \<not> P\<^sub>A.arr T \<Longrightarrow> ?Fx T = P\<^sub>B.null"
         by (simp add: P\<^sub>A.arr_char P\<^sub>B.null_char)
       show "\<And>T U. P\<^sub>A.con T U \<Longrightarrow> P\<^sub>B.con (?Fx T) (?Fx U)"
         using P\<^sub>A.Con_implies_Arr(1) P\<^sub>A.Con_implies_Arr(2) P\<^sub>A.con_char map_Resid by fastforce
       show "\<And>T U. P\<^sub>A.con T U \<Longrightarrow> ?Fx (P\<^sub>A.Resid T U) = P\<^sub>B.Resid (?Fx T) (?Fx U)"
         by (simp add: P\<^sub>A.Con_imp_Arr_Resid P\<^sub>A.Con_implies_Arr(1) P\<^sub>A.Con_implies_Arr(2)
             P\<^sub>A.con_char map_Resid)
     qed
 
     lemma lifts_to_paths:
     shows "simulation P\<^sub>A.Resid P\<^sub>B.Resid (\<lambda>T. if P\<^sub>A.Arr T then map F T else [])"
       ..
 
   end
 
   subsection "Normal Sub-RTS's Lift to Paths"
 
   text \<open>
     Here we show that a normal sub-RTS \<open>N\<close> of an RTS \<open>R\<close> lifts to a normal sub-RTS
     of the RTS of paths in \<open>N\<close>, and that it is coherent if \<open>N\<close> is.
   \<close>
 
   locale paths_in_rts_with_normal =
     R: rts +
     N: normal_sub_rts +
     paths_in_rts
   begin
 
     text \<open>
       We define a ``normal path'' to be a path that consists entirely of normal transitions.
       We show that the collection of all normal paths is a normal sub-RTS of the RTS of paths.
     \<close>
 
     definition NPath
     where "NPath T \<equiv> (Arr T \<and> set T \<subseteq> \<NN>)"
 
     lemma Ide_implies_NPath:
     assumes "Ide T"
     shows "NPath T"
       using assms
       by (metis Ball_Collect NPath_def Ide_implies_Arr N.ide_closed set_Ide_subset_ide
           subsetI)
 
     lemma NPath_implies_Arr:
     assumes "NPath T"
     shows "Arr T"
       using assms NPath_def by simp
 
     lemma NPath_append:
     assumes "T \<noteq> []" and "U \<noteq> []"
     shows "NPath (T @ U) \<longleftrightarrow> NPath T \<and> NPath U \<and> Trgs T \<subseteq> Srcs U"
       using assms NPath_def by auto
       
     lemma NPath_appendI [intro, simp]:
     assumes "NPath T" and "NPath U" and "Trgs T \<subseteq> Srcs U"
     shows "NPath (T @ U)"
       using assms NPath_def by simp
 
     lemma NPath_Resid_single_Arr:
-    shows "\<And>t. \<lbrakk>t \<in> \<NN>; Arr U; R.sources t = Srcs U\<rbrakk> \<Longrightarrow> NPath (Resid [t] U)"
-    proof (induct U)
+    shows "\<lbrakk>t \<in> \<NN>; Arr U; R.sources t = Srcs U\<rbrakk> \<Longrightarrow> NPath (Resid [t] U)"
+    proof (induct U arbitrary: t)
       show "\<And>t. \<lbrakk>t \<in> \<NN>; Arr []; R.sources t = Srcs []\<rbrakk> \<Longrightarrow> NPath (Resid [t] [])"
         by simp
       fix t u U
       assume ind: "\<And>t. \<lbrakk>t \<in> \<NN>; Arr U; R.sources t = Srcs U\<rbrakk> \<Longrightarrow> NPath (Resid [t] U)"
       assume t: "t \<in> \<NN>"
       assume uU: "Arr (u # U)"
       assume src: "R.sources t = Srcs (u # U)"
       show "NPath (Resid [t] (u # U))"
       proof (cases "U = []")
         show "U = [] \<Longrightarrow> ?thesis"
           using NPath_def t src
           apply simp
           by (metis Arr.simps(2) R.arr_resid_iff_con R.coinitialI N.forward_stable
               N.elements_are_arr uU)
         assume U: "U \<noteq> []"
         show ?thesis
         proof -
           have "NPath (Resid [t] (u # U)) \<longleftrightarrow> NPath (Resid [t \\ u] U)"
             using t U uU src
             by (metis Arr.simps(2) Con_implies_Arr(1) Resid_rec(3) Con_rec(3) R.arr_resid_iff_con)
           also have "... \<longleftrightarrow> True"
           proof -
             have "t \\ u \<in> \<NN>"
               using t U uU src N.forward_stable [of t u]
               by (metis Con_Arr_self Con_imp_eq_Srcs Con_initial_left
                         Srcs.simps(2) inf.idem Arr_has_Src R.coinitial_def)
             moreover have "Arr U"
               using U uU
               by (metis Arr.simps(3) neq_Nil_conv)
             moreover have "R.sources (t \\ u) = Srcs U"
               using t uU src
               by (metis Con_Arr_self Srcs.simps(2) U calculation(1) Con_imp_eq_Srcs
                         Con_rec(4) N.elements_are_arr R.sources_resid R.arr_resid_iff_con)
             ultimately show ?thesis
               using ind [of "t \\ u"] by simp
           qed
           finally show ?thesis by blast
         qed
       qed
     qed
 
     lemma NPath_Resid_Arr_single:
-    shows "\<And>u. \<lbrakk> NPath T; R.arr u; Srcs T = R.sources u \<rbrakk> \<Longrightarrow> NPath (Resid T [u])"
-    proof (induct T)
+    shows "\<lbrakk> NPath T; R.arr u; Srcs T = R.sources u \<rbrakk> \<Longrightarrow> NPath (Resid T [u])"
+    proof (induct T arbitrary: u)
       show "\<And>u. \<lbrakk>NPath []; R.arr u; Srcs [] = R.sources u\<rbrakk> \<Longrightarrow> NPath (Resid [] [u])"
         by simp
       fix t u T
       assume ind: "\<And>u. \<lbrakk>NPath T; R.arr u; Srcs T = R.sources u\<rbrakk> \<Longrightarrow> NPath (Resid T [u])"
       assume tT: "NPath (t # T)"
       assume u: "R.arr u"
       assume src: "Srcs (t # T) = R.sources u"
       show "NPath (Resid (t # T) [u])"
       proof (cases "T = []")
         show "T = [] \<Longrightarrow> ?thesis"
           using tT u src NPath_def
           by (metis Arr.simps(2) NPath_Resid_single_Arr Srcs.simps(2) list.set_intros(1) subsetD)
         assume T: "T \<noteq> []"
         have "R.coinitial u t"
           by (metis R.coinitialI Srcs.simps(3) T list.exhaust_sel src u)
         hence con: "t \<frown> u"
           using tT T u src R.con_sym NPath_def
           by (metis N.forward_stable N.elements_are_arr R.not_arr_null
               list.set_intros(1) R.conI subsetD)
         have 1: "NPath (Resid (t # T) [u]) \<longleftrightarrow> NPath ((t \\ u) # Resid T [u \\ t])"
         proof -
           have "t # T \<^sup>*\<frown>\<^sup>* [u]"
           proof -
             have 2: "[t] \<^sup>*\<frown>\<^sup>* [u]"
               by (simp add: Con_rec(1) con)
             moreover have "T \<^sup>*\<frown>\<^sup>* Resid [u] [t]"
             proof -
               have "NPath T"
                 using tT T NPath_def
                 by (metis NPath_append append_Cons append_Nil)
               moreover have 3: "R.arr (u \\ t)"
                 using con by (meson R.arr_resid_iff_con R.con_sym)
               moreover have "Srcs T = R.sources (u \\ t)"
                 using tT T u src con
                 by (metis "3" Arr_iff_Con_self Con_cons(2) Con_imp_eq_Srcs
                     R.sources_resid Srcs_Resid Trgs.simps(2) NPath_implies_Arr list.discI
                     R.arr_resid_iff_con)
               ultimately show ?thesis
                 using 2 ind [of "u \\ t"] NPath_def by auto
             qed
             ultimately show ?thesis
               using tT T u src Con_cons(1) [of T "[u]" t] by simp
           qed
           thus ?thesis
             using tT T u src Resid_cons(1) [of T t "[u]"] Resid_rec(2) by presburger
         qed
         also have "... \<longleftrightarrow> True"
         proof -
           have 2: "t \\ u \<in> \<NN> \<and> R.arr (u \\ t)"
             using tT u src con NPath_def
             by (meson R.arr_resid_iff_con R.con_sym N.forward_stable \<open>R.coinitial u t\<close>
                 list.set_intros(1) subsetD)
           moreover have 3: "NPath (T \<^sup>*\\\<^sup>* [u \\ t])"
             using tT ind [of "u \\ t"] NPath_def
             by (metis Con_Arr_self Con_imp_eq_Srcs Con_rec(4) R.arr_resid_iff_con
                 R.sources_resid Srcs.simps(2) T calculation insert_subset list.exhaust
                 list.simps(15) Arr.simps(3))
           moreover have "R.targets (t \\ u) \<subseteq> Srcs (Resid T [u \\ t])"
             using tT T u src NPath_def
             by (metis "3" Arr.simps(1) R.targets_resid_sym Srcs_Resid_Arr_single con subset_refl)
           ultimately show ?thesis
             using NPath_def
             by (metis Arr_consI\<^sub>P N.elements_are_arr insert_subset list.simps(15))
         qed
         finally show ?thesis by blast
       qed
     qed
 
     lemma NPath_Resid [simp]:
-    shows "\<And>U. \<lbrakk>NPath T; Arr U; Srcs T = Srcs U\<rbrakk> \<Longrightarrow> NPath (T \<^sup>*\\\<^sup>* U)"
-    proof (induct T)
+    shows "\<lbrakk>NPath T; Arr U; Srcs T = Srcs U\<rbrakk> \<Longrightarrow> NPath (T \<^sup>*\\\<^sup>* U)"
+    proof (induct T arbitrary: U)
       show "\<And>U. \<lbrakk>NPath []; Arr U; Srcs [] = Srcs U\<rbrakk> \<Longrightarrow> NPath ([] \<^sup>*\\\<^sup>* U)"
         by simp
       fix t T U
       assume ind: "\<And>U. \<lbrakk>NPath T; Arr U; Srcs T = Srcs U\<rbrakk> \<Longrightarrow> NPath (T \<^sup>*\\\<^sup>* U)"
       assume tT: "NPath (t # T)"
       assume U: "Arr U"
       assume Coinitial: "Srcs (t # T) = Srcs U"
       show "NPath ((t # T) \<^sup>*\\\<^sup>* U)"
       proof (cases "T = []")
         show "T = [] \<Longrightarrow> ?thesis"
           using tT U Coinitial NPath_Resid_single_Arr [of t U] NPath_def by force
         assume T: "T \<noteq> []"
         have 0: "NPath ((t # T) \<^sup>*\\\<^sup>* U) \<longleftrightarrow> NPath ([t] \<^sup>*\\\<^sup>* U @ T \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* [t]))"
         proof -
           have "U \<noteq> []"
             using U by auto
           moreover have "(t # T) \<^sup>*\<frown>\<^sup>* U"
           proof -
             have "t \<in> \<NN>"
               using tT NPath_def by auto
             moreover have "R.sources t = Srcs U"
               using Coinitial
               by (metis Srcs.elims U list.sel(1) Arr_has_Src)
             ultimately have 1: "[t] \<^sup>*\<frown>\<^sup>* U"
               using U NPath_Resid_single_Arr [of t U] NPath_def by auto
             moreover have "T \<^sup>*\<frown>\<^sup>* (U \<^sup>*\\\<^sup>* [t])"
             proof -
               have "Srcs T = Srcs (U \<^sup>*\\\<^sup>* [t])"
                 using tT U Coinitial 1
                 by (metis Con_Arr_self Con_cons(2) Con_imp_eq_Srcs Con_sym Srcs_Resid_Arr_single
                     T list.discI NPath_implies_Arr)
               hence "NPath (T \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* [t]))"
                 using tT U Coinitial 1 Con_sym ind [of "Resid U [t]"] NPath_def
                 by (metis Con_imp_Arr_Resid Srcs.elims T insert_subset list.simps(15)
                     Arr.simps(3))
               thus ?thesis
                 using NPath_def by auto
             qed
             ultimately show ?thesis
               using Con_cons(1) [of T U t] by fastforce
           qed
           ultimately show ?thesis
             using tT U T Coinitial Resid_cons(1) by auto
         qed
         also have "... \<longleftrightarrow> True"
         proof (intro iffI, simp_all)
           have 1: "NPath ([t] \<^sup>*\\\<^sup>* U)"
             by (metis Coinitial NPath_Resid_single_Arr Srcs_simp\<^sub>P U insert_subset
                 list.sel(1) list.simps(15) NPath_def tT)
           moreover have 2: "NPath (T \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* [t]))"
             by (metis "0" Arr.simps(1) Con_cons(1) Con_imp_eq_Srcs Con_implies_Arr(1-2)
                 NPath_def T append_Nil2 calculation ind insert_subset list.simps(15) tT)
           moreover have "Trgs ([t] \<^sup>*\\\<^sup>* U) \<subseteq> Srcs (T \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* [t]))"
             by (metis Arr.simps(1) NPath_def Srcs_Resid Trgs_Resid_sym calculation(2)
                 dual_order.refl)
           ultimately show "NPath ([t] \<^sup>*\\\<^sup>* U @ T \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* [t]))"
             using NPath_append [of "T \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* [t])" "[t] \<^sup>*\\\<^sup>* U"] by fastforce
         qed
         finally show ?thesis by blast
       qed
     qed
 
     lemma Backward_stable_single:
-    shows "\<And>t. \<lbrakk>NPath U; NPath ([t] \<^sup>*\\\<^sup>* U)\<rbrakk> \<Longrightarrow> NPath [t]"
-    proof (induct U)
+    shows "\<lbrakk>NPath U; NPath ([t] \<^sup>*\\\<^sup>* U)\<rbrakk> \<Longrightarrow> NPath [t]"
+    proof (induct U arbitrary: t)
       show "\<And>t. \<lbrakk>NPath []; NPath ([t] \<^sup>*\\\<^sup>* [])\<rbrakk> \<Longrightarrow> NPath [t]"
         using NPath_def by simp
       fix t u U
       assume ind: "\<And>t. \<lbrakk>NPath U; NPath ([t] \<^sup>*\\\<^sup>* U)\<rbrakk> \<Longrightarrow> NPath [t]"
       assume uU: "NPath (u # U)"
       assume resid: "NPath ([t] \<^sup>*\\\<^sup>* (u # U))"
       show "NPath [t]"
         using uU ind NPath_def
         by (metis Arr.simps(1) Arr.simps(2) Con_implies_Arr(2) N.backward_stable
             N.elements_are_arr Resid_rec(1) Resid_rec(3) insert_subset list.simps(15) resid)
     qed
 
     lemma Backward_stable:
-    shows "\<And>U. \<lbrakk>NPath U; NPath (T \<^sup>*\\\<^sup>* U)\<rbrakk> \<Longrightarrow> NPath T"
-    proof (induct T)
+    shows "\<lbrakk>NPath U; NPath (T \<^sup>*\\\<^sup>* U)\<rbrakk> \<Longrightarrow> NPath T"
+    proof (induct T arbitrary: U)
       show "\<And>U. \<lbrakk>NPath U; NPath ([] \<^sup>*\\\<^sup>* U)\<rbrakk> \<Longrightarrow> NPath []"
         by simp
       fix t T U
       assume ind: "\<And>U. \<lbrakk>NPath U; NPath (T \<^sup>*\\\<^sup>* U)\<rbrakk> \<Longrightarrow> NPath T"
       assume U: "NPath U"
       assume resid: "NPath ((t # T) \<^sup>*\\\<^sup>* U)"
       show "NPath (t # T)"
       proof (cases "T = []")
         show "T = [] \<Longrightarrow> ?thesis"
           using U resid Backward_stable_single by blast
         assume T: "T \<noteq> []"
         have 1: "NPath ([t] \<^sup>*\\\<^sup>* U) \<and> NPath (T \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* [t]))"
           using T U NPath_append resid NPath_def
           by (metis Arr.simps(1) Con_cons(1) Resid_cons(1))
         have 2: "t \<in> \<NN>"
           using 1 U Backward_stable_single NPath_def by simp
         moreover have "NPath T"
           using 1 U resid ind
           by (metis 2 Arr.simps(2) Con_imp_eq_Srcs NPath_Resid N.elements_are_arr)
         moreover have "R.targets t \<subseteq> Srcs T"
           using resid 1 Con_imp_eq_Srcs Con_sym Srcs_Resid_Arr_single NPath_def
           by (metis Arr.simps(1) dual_order.eq_iff)
         ultimately show ?thesis
           using NPath_def
           by (simp add: N.elements_are_arr)
       qed
     qed
 
     sublocale normal_sub_rts Resid \<open>Collect NPath\<close>
       using Ide_implies_NPath NPath_implies_Arr arr_char ide_char coinitial_def
             sources_char\<^sub>P append_is_composite_of
       apply unfold_locales
            apply auto
       using Backward_stable
       by metis+
 
     theorem normal_extends_to_paths:
     shows "normal_sub_rts Resid (Collect NPath)"
       ..
 
     lemma Resid_NPath_preserves_reflects_Con:
     assumes "NPath U" and "Srcs T = Srcs U"
     shows "T \<^sup>*\\\<^sup>* U \<^sup>*\<frown>\<^sup>* T' \<^sup>*\\\<^sup>* U \<longleftrightarrow> T \<^sup>*\<frown>\<^sup>* T'"
       using assms NPath_def NPath_Resid con_char con_imp_coinitial resid_along_elem_preserves_con
             Con_implies_Arr(2) Con_sym Cube(1)
       by (metis Arr.simps(1) mem_Collect_eq)
 
     notation Cong\<^sub>0  (infix "\<approx>\<^sup>*\<^sub>0" 50)
     notation Cong  (infix "\<approx>\<^sup>*" 50)
 
     (*
      * TODO: Leave these for now -- they still seem a little difficult to prove
      * in this context, but are probably useful.
      *)
     lemma Cong\<^sub>0_cancel_left\<^sub>C\<^sub>S:
     assumes "T @ U \<approx>\<^sup>*\<^sub>0 T @ U'" and "T \<noteq> []" and "U \<noteq> []" and "U' \<noteq> []"
     shows "U \<approx>\<^sup>*\<^sub>0 U'"
       using assms Cong\<^sub>0_cancel_left [of T U "T @ U" U' "T @ U'"] Cong\<^sub>0_reflexive
             append_is_composite_of
       by (metis Cong\<^sub>0_implies_Cong Cong_imp_arr(1) arr_append_imp_seq)
 
     lemma Srcs_respects_Cong:
     assumes "T \<approx>\<^sup>* T'" and "a \<in> Srcs T" and "a' \<in> Srcs T'"
     shows "[a] \<approx>\<^sup>* [a']"
     proof -
       obtain U U' where UU': "NPath U \<and> NPath U' \<and> T \<^sup>*\\\<^sup>* U \<approx>\<^sup>*\<^sub>0 T' \<^sup>*\\\<^sup>* U'"
         using assms(1) by blast
       show ?thesis
       proof
         show "U \<in> Collect NPath"
           using UU' by simp
         show "U' \<in> Collect NPath"
           using UU' by simp
         show "[a] \<^sup>*\\\<^sup>* U \<approx>\<^sup>*\<^sub>0 [a'] \<^sup>*\\\<^sup>* U'"
         proof -
           have "NPath ([a] \<^sup>*\\\<^sup>* U) \<and> NPath ([a'] \<^sup>*\\\<^sup>* U')"
             by (metis Arr.simps(1) Con_imp_eq_Srcs Con_implies_Arr(1) Con_single_ide_ind
                 NPath_implies_Arr N.ide_closed R.in_sourcesE Srcs.simps(2) Srcs_simp\<^sub>P
                 UU' assms(2-3) elements_are_arr not_arr_null null_char NPath_Resid_single_Arr)
           thus ?thesis
             using UU'
             by (metis Con_imp_eq_Srcs Cong\<^sub>0_imp_con NPath_Resid Srcs_Resid
                 con_char NPath_implies_Arr mem_Collect_eq arr_resid_iff_con con_implies_arr(2))
         qed
       qed
     qed
 
     lemma Trgs_respects_Cong:
     assumes "T \<approx>\<^sup>* T'" and "b \<in> Trgs T" and "b' \<in> Trgs T'"
     shows "[b] \<approx>\<^sup>* [b']"
     proof -
       have "[b] \<in> targets T \<and> [b'] \<in> targets T'"
       proof -
         have 1: "Ide [b] \<and> Ide [b']"
           using assms
           by (metis Ball_Collect Trgs_are_ide Ide.simps(2))
         moreover have "Srcs [b] = Trgs T"
           using assms
           by (metis 1 Con_imp_Arr_Resid Con_imp_eq_Srcs Cong_imp_arr(1) Ide.simps(2)
               Srcs_Resid Con_single_ide_ind con_char arrE)
         moreover have "Srcs [b'] = Trgs T'"
           using assms
           by (metis Con_imp_Arr_Resid Con_imp_eq_Srcs Cong_imp_arr(2) Ide.simps(2)
               Srcs_Resid 1 Con_single_ide_ind con_char arrE)
         ultimately show ?thesis
           unfolding targets_char\<^sub>P
           using assms Cong_imp_arr(2) arr_char by blast
       qed
       thus ?thesis
         using assms targets_char in_targets_respects_Cong [of T T' "[b]" "[b']"] by simp
     qed
 
     lemma Cong\<^sub>0_append_resid_NPath:
     assumes "NPath (T \<^sup>*\\\<^sup>* U)"
     shows "Cong\<^sub>0 (T @ (U \<^sup>*\\\<^sup>* T)) U"
     proof (intro conjI)
       show 0: "(T @ U \<^sup>*\\\<^sup>* T) \<^sup>*\\\<^sup>* U \<in> Collect NPath"
       proof -
         have 1: "(T @ U \<^sup>*\\\<^sup>* T) \<^sup>*\\\<^sup>* U = T \<^sup>*\\\<^sup>* U @ (U \<^sup>*\\\<^sup>* T) \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* T)"
           by (metis Arr.simps(1) NPath_implies_Arr assms Con_append(1) Con_implies_Arr(2)
               Con_sym Resid_append(1) con_imp_arr_resid null_char)
         moreover have "NPath ..."
           using assms
           by (metis 1 Arr_append_iff\<^sub>P NPath_append NPath_implies_Arr Ide_implies_NPath
               Nil_is_append_conv Resid_Arr_self arr_char con_char arr_resid_iff_con
               self_append_conv)
         ultimately show ?thesis by simp
       qed
       show "U \<^sup>*\\\<^sup>* (T @ U \<^sup>*\\\<^sup>* T) \<in> Collect NPath"
         using assms 0
         by (metis Arr.simps(1) Con_implies_Arr(2) Cong\<^sub>0_reflexive Resid_append(2)
             append.right_neutral arr_char Con_sym)
     qed
 
   end
 
   locale paths_in_rts_with_coherent_normal =
     R: rts +
     N: coherent_normal_sub_rts +
     paths_in_rts
   begin
 
     sublocale paths_in_rts_with_normal resid \<NN> ..
 
     notation Cong\<^sub>0  (infix "\<approx>\<^sup>*\<^sub>0" 50)
     notation Cong  (infix "\<approx>\<^sup>*" 50)
 
     text \<open>
       Since composites of normal transitions are assumed to exist, normal paths can be
       ``folded'' by composition down to single transitions.
     \<close>
 
     lemma NPath_folding:
     shows "NPath U \<Longrightarrow> \<exists>u. u \<in> \<NN> \<and> R.sources u = Srcs U \<and> R.targets u = Trgs U \<and>
                            (\<forall>t. con [t] U \<longrightarrow> [t] \<^sup>*\\\<^sup>* U \<approx>\<^sup>*\<^sub>0 [t \\ u])"
     proof (induct U)
       show "NPath [] \<Longrightarrow> \<exists>u. u \<in> \<NN> \<and> R.sources u = Srcs [] \<and> R.targets u = Trgs [] \<and>
                              (\<forall>t. con [t] [] \<longrightarrow> [t] \<^sup>*\\\<^sup>* [] \<approx>\<^sup>*\<^sub>0 [t \\ u])"
         using NPath_def by auto
       fix v U
       assume ind: "NPath U \<Longrightarrow> \<exists>u. u \<in> \<NN> \<and> R.sources u = Srcs U \<and> R.targets u = Trgs U \<and>
                                    (\<forall>t. con [t] U \<longrightarrow> [t] \<^sup>*\\\<^sup>* U \<approx>\<^sup>*\<^sub>0 [t \\ u])"
       assume vU: "NPath (v # U)"
       show "\<exists>vU. vU \<in> \<NN> \<and> R.sources vU = Srcs (v # U) \<and> R.targets vU = Trgs (v # U) \<and>
                  (\<forall>t. con [t] (v # U) \<longrightarrow> [t] \<^sup>*\\\<^sup>* (v # U) \<approx>\<^sup>*\<^sub>0 [t \\ vU])"
       proof (cases "U = []")
         show "U = [] \<Longrightarrow> \<exists>vU. vU \<in> \<NN> \<and> R.sources vU = Srcs (v # U) \<and>
                               R.targets vU = Trgs (v # U) \<and>
                               (\<forall>t. con [t] (v # U) \<longrightarrow> [t] \<^sup>*\\\<^sup>* (v # U) \<approx>\<^sup>*\<^sub>0 [t \\ vU])"
           using vU Resid_rec(1) con_char
           by (metis Cong\<^sub>0_reflexive NPath_def Srcs.simps(2) Trgs.simps(2) arr_resid_iff_con
               insert_subset list.simps(15))
         assume "U \<noteq> []"
         hence U: "NPath U"
           using vU by (metis NPath_append append_Cons append_Nil)
         obtain u where u: "u \<in> \<NN> \<and> R.sources u = Srcs U \<and> R.targets u = Trgs U \<and>
                            (\<forall>t. con [t] U \<longrightarrow> [t] \<^sup>*\\\<^sup>* U \<approx>\<^sup>*\<^sub>0 [t \\ u])"
           using U ind by blast
         have seq: "R.seq v u"
         proof
           show "R.arr v"
             using vU
             by (metis Con_Arr_self Con_rec(4) NPath_implies_Arr \<open>U \<noteq> []\<close> R.arrI)
           show "R.arr u"
             by (simp add: N.elements_are_arr u)
           show "R.targets v = R.sources u"
             by (metis (full_types) NPath_implies_Arr R.sources_resid Srcs.simps(2) \<open>U \<noteq> []\<close>
                 Con_Arr_self Con_imp_eq_Srcs Con_initial_right Con_rec(2) u vU)
         qed
         obtain vu where vu: "R.composite_of v u vu"
           using N.composite_closed_right seq u by presburger
         have "vu \<in> \<NN> \<and> R.sources vu = Srcs (v # U) \<and> R.targets vu = Trgs (v # U) \<and>
               (\<forall>t. con [t] (v # U) \<longrightarrow> [t] \<^sup>*\\\<^sup>* (v # U) \<approx>\<^sup>*\<^sub>0 [t \\ vu])"
         proof (intro conjI allI)
           show "vu \<in> \<NN>"
             by (meson NPath_def N.composite_closed list.set_intros(1) subsetD u vU vu)
           show "R.sources vu = Srcs (v # U)"
             by (metis Con_imp_eq_Srcs Con_initial_right NPath_implies_Arr
                       R.sources_composite_of Srcs.simps(2) Arr_iff_Con_self vU vu)
           show "R.targets vu = Trgs (v # U)"
             by (metis R.targets_composite_of Trgs.simps(3) \<open>U \<noteq> []\<close> list.exhaust_sel u vu)
           fix t
           show "con [t] (v # U) \<longrightarrow> [t] \<^sup>*\\\<^sup>* (v # U) \<approx>\<^sup>*\<^sub>0 [t \\ vu]"
           proof (intro impI)
             assume t: "con [t] (v # U)"
             have 1: "[t] \<^sup>*\\\<^sup>* (v # U) = [t \\ v] \<^sup>*\\\<^sup>* U"
               using t Resid_rec(3) \<open>U \<noteq> []\<close> con_char by force
             also have "... \<approx>\<^sup>*\<^sub>0 [(t \\ v) \\ u]"
               using 1 t u by force
             also have "[(t \\ v) \\ u] \<approx>\<^sup>*\<^sub>0 [t \\ vu]"
             proof -
               have "(t \\ v) \\ u \<sim> t \\ vu"
                 using vu R.resid_composite_of
                 by (metis (no_types, lifting) N.Cong\<^sub>0_composite_of_arr_normal N.Cong\<^sub>0_subst_right(1)
                     \<open>U \<noteq> []\<close> Con_rec(3) con_char R.con_sym t u)
               thus ?thesis
                 using Ide.simps(2) R.prfx_implies_con Resid.simps(3) ide_char ide_closed
                 by presburger
             qed
             finally show "[t] \<^sup>*\\\<^sup>* (v # U) \<approx>\<^sup>*\<^sub>0 [t \\ vu]" by blast
           qed
         qed
         thus ?thesis by blast
       qed
     qed
 
     text \<open>
       Coherence for single transitions extends inductively to paths.
     \<close>
 
     lemma Coherent_single:
     assumes "R.arr t" and "NPath U" and "NPath U'"
     and "R.sources t = Srcs U" and "Srcs U = Srcs U'" and "Trgs U = Trgs U'"
     shows "[t] \<^sup>*\\\<^sup>* U \<approx>\<^sup>*\<^sub>0 [t] \<^sup>*\\\<^sup>* U'"
     proof -
       have 1: "con [t] U \<and> con [t] U'"
         using assms
         by (metis Arr.simps(1-2) Arr_iff_Con_self Resid_NPath_preserves_reflects_Con
             Srcs.simps(2) con_char)
       obtain u where u: "u \<in> \<NN> \<and> R.sources u = Srcs U \<and> R.targets u = Trgs U \<and>
                          (\<forall>t. con [t] U \<longrightarrow> [t] \<^sup>*\\\<^sup>* U \<approx>\<^sup>*\<^sub>0 [t \\ u])"
         using assms NPath_folding by metis
       obtain u' where u': "u' \<in> \<NN> \<and> R.sources u' = Srcs U' \<and> R.targets u' = Trgs U' \<and>
                            (\<forall>t. con [t] U' \<longrightarrow> [t] \<^sup>*\\\<^sup>* U' \<approx>\<^sup>*\<^sub>0 [t \\ u'])"
         using assms NPath_folding by metis
       have "[t] \<^sup>*\\\<^sup>* U  \<approx>\<^sup>*\<^sub>0 [t \\ u]"
         using u 1 by blast
       also have "[t \\ u] \<approx>\<^sup>*\<^sub>0 [t \\ u']"
         using assms(1,4-6) N.Cong\<^sub>0_imp_con N.coherent u u' NPath_def by simp
       also have "[t \\ u'] \<approx>\<^sup>*\<^sub>0 [t] \<^sup>*\\\<^sup>* U'"
         using u' 1 by simp
       finally show ?thesis by simp
     qed
 
     lemma Coherent:
-    shows "\<And>U U'. \<lbrakk> Arr T; NPath U; NPath U'; Srcs T = Srcs U;
-                    Srcs U = Srcs U'; Trgs U = Trgs U' \<rbrakk>
-                       \<Longrightarrow> T \<^sup>*\\\<^sup>* U \<approx>\<^sup>*\<^sub>0 T \<^sup>*\\\<^sup>* U'"
-    proof (induct T)
+    shows "\<lbrakk> Arr T; NPath U; NPath U'; Srcs T = Srcs U;
+             Srcs U = Srcs U'; Trgs U = Trgs U' \<rbrakk>
+                \<Longrightarrow> T \<^sup>*\\\<^sup>* U \<approx>\<^sup>*\<^sub>0 T \<^sup>*\\\<^sup>* U'"
+    proof (induct T arbitrary: U U')
       show "\<And>U U'. \<lbrakk> Arr []; NPath U; NPath U'; Srcs [] = Srcs U;
                     Srcs U = Srcs U'; Trgs U = Trgs U' \<rbrakk>
                       \<Longrightarrow> [] \<^sup>*\\\<^sup>* U \<approx>\<^sup>*\<^sub>0 [] \<^sup>*\\\<^sup>* U'"
         by (simp add: arr_char)
       fix t T U U'
       assume tT: "Arr (t # T)" and U: "NPath U" and U': "NPath U'"
       and Srcs1: "Srcs (t # T) = Srcs U" and Srcs2: "Srcs U = Srcs U'"
       and Trgs: "Trgs U = Trgs U'"
       and ind: "\<And>U U'. \<lbrakk> Arr T; NPath U; NPath U'; Srcs T = Srcs U;
                         Srcs U = Srcs U'; Trgs U = Trgs U' \<rbrakk>
                             \<Longrightarrow> T \<^sup>*\\\<^sup>* U \<approx>\<^sup>*\<^sub>0 T \<^sup>*\\\<^sup>* U'"
       have t: "R.arr t"
         using tT by (metis Arr.simps(2) Con_Arr_self Con_rec(4) R.arrI)
       show "(t # T) \<^sup>*\\\<^sup>* U \<approx>\<^sup>*\<^sub>0 (t # T) \<^sup>*\\\<^sup>* U'"
       proof (cases "T = []")
         show "T = [] \<Longrightarrow> ?thesis"
            by (metis Srcs.simps(2) Srcs1 Srcs2 Trgs U U' Coherent_single Arr.simps(2) tT)
         assume T: "T \<noteq> []"
         let ?t = "[t] \<^sup>*\\\<^sup>* U" and ?t' = "[t] \<^sup>*\\\<^sup>* U'"
         let ?T = "T \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* [t])"
         let ?T' = "T \<^sup>*\\\<^sup>* (U' \<^sup>*\\\<^sup>* [t])"
         have 0: "(t # T) \<^sup>*\\\<^sup>* U = ?t @ ?T \<and> (t # T) \<^sup>*\\\<^sup>* U' = ?t' @ ?T'"
           using tT U U' Srcs1 Srcs2
           by (metis Arr_has_Src Arr_iff_Con_self Resid_cons(1) Srcs.simps(1)
               Resid_NPath_preserves_reflects_Con)
         have 1: "?t \<approx>\<^sup>*\<^sub>0 ?t'"
           by (metis Srcs1 Srcs2 Srcs_simp\<^sub>P Trgs U U' list.sel(1) Coherent_single t tT)
         have A: "?T \<^sup>*\\\<^sup>* (?t' \<^sup>*\\\<^sup>* ?t) = T \<^sup>*\\\<^sup>* ((U \<^sup>*\\\<^sup>* [t]) @ (?t' \<^sup>*\\\<^sup>* ?t))"
           using 1 Arr.simps(1) Con_append(2) Con_sym Resid_append(2) Con_implies_Arr(1)
                 NPath_def
           by (metis arr_char elements_are_arr)
         have B: "?T' \<^sup>*\\\<^sup>* (?t \<^sup>*\\\<^sup>* ?t') = T \<^sup>*\\\<^sup>* ((U' \<^sup>*\\\<^sup>* [t]) @ (?t \<^sup>*\\\<^sup>* ?t'))"
           by (metis "1" Con_appendI(2) Con_sym Resid.simps(1) Resid_append(2) elements_are_arr
               not_arr_null null_char)
         have E: "?T \<^sup>*\\\<^sup>* (?t' \<^sup>*\\\<^sup>* ?t) \<approx>\<^sup>*\<^sub>0 ?T' \<^sup>*\\\<^sup>* (?t \<^sup>*\\\<^sup>* ?t')"
         proof -
           have "Arr T"
             using Arr.elims(1) T tT by blast
           moreover have "NPath (U \<^sup>*\\\<^sup>* [t] @ ([t] \<^sup>*\\\<^sup>* U') \<^sup>*\\\<^sup>* ([t] \<^sup>*\\\<^sup>* U))"
             using 1 U t tT Srcs1 Srcs_simp\<^sub>P
             apply (intro NPath_appendI)
               apply auto
             by (metis Arr.simps(1) NPath_def Srcs_Resid Trgs_Resid_sym)
           moreover have "NPath (U' \<^sup>*\\\<^sup>* [t] @ ([t] \<^sup>*\\\<^sup>* U) \<^sup>*\\\<^sup>* ([t] \<^sup>*\\\<^sup>* U'))"
             using t U' 1 Con_imp_eq_Srcs Trgs_Resid_sym
             apply (intro NPath_appendI)
               apply auto
              apply (metis Arr.simps(2) NPath_Resid Resid.simps(1))
             by (metis Arr.simps(1) NPath_def Srcs_Resid)
           moreover have "Srcs T = Srcs (U \<^sup>*\\\<^sup>* [t] @ ([t] \<^sup>*\\\<^sup>* U') \<^sup>*\\\<^sup>* ([t] \<^sup>*\\\<^sup>* U))"
             using A B
             by (metis (full_types) "0" "1" Arr_has_Src Con_cons(1) Con_implies_Arr(1)
                 Srcs.simps(1) Srcs_append T elements_are_arr not_arr_null null_char
                 Con_imp_eq_Srcs)
           moreover have "Srcs (U \<^sup>*\\\<^sup>* [t] @ ([t] \<^sup>*\\\<^sup>* U') \<^sup>*\\\<^sup>* ([t] \<^sup>*\\\<^sup>* U)) =
                          Srcs (U' \<^sup>*\\\<^sup>* [t] @ ([t] \<^sup>*\\\<^sup>* U) \<^sup>*\\\<^sup>* ([t] \<^sup>*\\\<^sup>* U'))"
             by (metis "1" Con_implies_Arr(2) Con_sym Cong\<^sub>0_imp_con Srcs_Resid Srcs_append
                 arr_char con_char arr_resid_iff_con)
           moreover have "Trgs (U \<^sup>*\\\<^sup>* [t] @ ([t] \<^sup>*\\\<^sup>* U') \<^sup>*\\\<^sup>* ([t] \<^sup>*\\\<^sup>* U)) =
                          Trgs (U' \<^sup>*\\\<^sup>* [t] @ ([t] \<^sup>*\\\<^sup>* U) \<^sup>*\\\<^sup>* ([t] \<^sup>*\\\<^sup>* U'))"
             using "1" Cong\<^sub>0_imp_con con_char by force
           ultimately show ?thesis
             using A B ind [of "(U \<^sup>*\\\<^sup>* [t]) @ (?t' \<^sup>*\\\<^sup>* ?t)" "(U' \<^sup>*\\\<^sup>* [t]) @ (?t \<^sup>*\\\<^sup>* ?t')"]
             by simp
         qed
         have C: "NPath ((?T \<^sup>*\\\<^sup>* (?t' \<^sup>*\\\<^sup>* ?t)) \<^sup>*\\\<^sup>* (?T' \<^sup>*\\\<^sup>* (?t \<^sup>*\\\<^sup>* ?t')))"
           using E by blast
         have D: "NPath ((?T' \<^sup>*\\\<^sup>* (?t \<^sup>*\\\<^sup>* ?t')) \<^sup>*\\\<^sup>* (?T \<^sup>*\\\<^sup>* (?t' \<^sup>*\\\<^sup>* ?t)))"
           using E by blast
         show ?thesis
         proof
           have 2: "((t # T) \<^sup>*\\\<^sup>* U) \<^sup>*\\\<^sup>* ((t # T) \<^sup>*\\\<^sup>* U') =
                    ((?t \<^sup>*\\\<^sup>* ?t') \<^sup>*\\\<^sup>* ?T') @ ((?T \<^sup>*\\\<^sup>* (?t' \<^sup>*\\\<^sup>* ?t)) \<^sup>*\\\<^sup>* (?T' \<^sup>*\\\<^sup>* (?t \<^sup>*\\\<^sup>* ?t')))"
           proof -
             have "((t # T) \<^sup>*\\\<^sup>* U) \<^sup>*\\\<^sup>* ((t # T) \<^sup>*\\\<^sup>* U') = (?t @ ?T) \<^sup>*\\\<^sup>* (?t' @ ?T')"
               using 0 by fastforce
             also have "... = ((?t @ ?T) \<^sup>*\\\<^sup>* ?t') \<^sup>*\\\<^sup>* ?T'"
               using tT T U U' Srcs1 Srcs2 0
               by (metis Con_appendI(2) Con_cons(1) Con_sym Resid.simps(1) Resid_append(2))
             also have "... = ((?t \<^sup>*\\\<^sup>* ?t') @ (?T \<^sup>*\\\<^sup>* (?t' \<^sup>*\\\<^sup>* ?t))) \<^sup>*\\\<^sup>* ?T'"
               by (metis (no_types, lifting) Arr.simps(1) Con_appendI(1) Con_implies_Arr(1)
                   D NPath_def Resid_append(1) null_is_zero(2))
             also have "... = ((?t \<^sup>*\\\<^sup>* ?t') \<^sup>*\\\<^sup>* ?T') @
                                ((?T \<^sup>*\\\<^sup>* (?t' \<^sup>*\\\<^sup>* ?t)) \<^sup>*\\\<^sup>* (?T' \<^sup>*\\\<^sup>* (?t \<^sup>*\\\<^sup>* ?t')))"
             proof -
               have "?t \<^sup>*\\\<^sup>* ?t' @ ?T \<^sup>*\\\<^sup>* (?t' \<^sup>*\\\<^sup>* ?t) \<^sup>*\<frown>\<^sup>* ?T'"
                 using C D E Con_sym
                 by (metis Con_append(2) Cong\<^sub>0_imp_con con_char arr_resid_iff_con
                           con_implies_arr(2))
               thus ?thesis
                 using Resid_append(1)
                 by (metis Con_sym append.right_neutral Resid.simps(1))
             qed
             finally show ?thesis by simp
           qed
           moreover have 3: "NPath ..."
           proof -
             have "NPath ((?t \<^sup>*\\\<^sup>* ?t') \<^sup>*\\\<^sup>* ?T')"
               using 0 1 E
               by (metis Con_imp_Arr_Resid Con_imp_eq_Srcs NPath_Resid Resid.simps(1)
                   ex_un_null mem_Collect_eq)
             moreover have "Trgs ((?t \<^sup>*\\\<^sup>* ?t') \<^sup>*\\\<^sup>* ?T') =
                            Srcs ((?T \<^sup>*\\\<^sup>* (?t' \<^sup>*\\\<^sup>* ?t)) \<^sup>*\\\<^sup>* (?T' \<^sup>*\\\<^sup>* (?t \<^sup>*\\\<^sup>* ?t')))"
               using C
               by (metis NPath_implies_Arr Srcs.simps(1) Srcs_Resid
                   Trgs_Resid_sym Arr_has_Src)
             ultimately show ?thesis
               using C by blast
           qed
           ultimately show "((t # T) \<^sup>*\\\<^sup>* U) \<^sup>*\\\<^sup>* ((t # T) \<^sup>*\\\<^sup>* U') \<in> Collect NPath"
             by simp
 
           have 4: "((t # T) \<^sup>*\\\<^sup>* U') \<^sup>*\\\<^sup>* ((t # T) \<^sup>*\\\<^sup>* U) =
                 ((?t' \<^sup>*\\\<^sup>* ?t) \<^sup>*\\\<^sup>* ?T) @ ((?T' \<^sup>*\\\<^sup>* (?t \<^sup>*\\\<^sup>* ?t')) \<^sup>*\\\<^sup>* (?T \<^sup>*\\\<^sup>* (?t' \<^sup>*\\\<^sup>* ?t)))"
             by (metis "0" "2" "3" Arr.simps(1) Con_implies_Arr(1) Con_sym D NPath_def Resid_append2)
           moreover have "NPath ..."
           proof -
             have "NPath ((?t' \<^sup>*\\\<^sup>* ?t) \<^sup>*\\\<^sup>* ?T)"
               by (metis "1" CollectD Cong\<^sub>0_imp_con E con_imp_coinitial forward_stable
                   arr_resid_iff_con con_implies_arr(2))
             moreover have "NPath ((?T' \<^sup>*\\\<^sup>* (?t \<^sup>*\\\<^sup>* ?t')) \<^sup>*\\\<^sup>* (?T \<^sup>*\\\<^sup>* (?t' \<^sup>*\\\<^sup>* ?t)))"
               using U U' 1 D ind Coherent_single [of t U' U] by blast
             moreover have "Trgs ((?t' \<^sup>*\\\<^sup>* ?t) \<^sup>*\\\<^sup>* ?T) =
                            Srcs ((?T' \<^sup>*\\\<^sup>* (?t \<^sup>*\\\<^sup>* ?t')) \<^sup>*\\\<^sup>* (?T \<^sup>*\\\<^sup>* (?t' \<^sup>*\\\<^sup>* ?t)))"
               by (metis Arr.simps(1) NPath_def Srcs_Resid Trgs_Resid_sym calculation(2))
             ultimately show ?thesis by blast
           qed
           ultimately show "((t # T) \<^sup>*\\\<^sup>* U') \<^sup>*\\\<^sup>* ((t # T) \<^sup>*\\\<^sup>* U) \<in> Collect NPath"
             by simp
         qed
       qed
     qed
 
     sublocale rts_with_composites Resid
       using is_rts_with_composites by simp
 
     sublocale coherent_normal_sub_rts Resid \<open>Collect NPath\<close>
     proof
       fix T U U'
       assume T: "arr T" and U: "U \<in> Collect NPath" and U': "U' \<in> Collect NPath"
       assume sources_UU': "sources U = sources U'" and targets_UU': "targets U = targets U'"
       and TU: "sources T = sources U"
       have "Srcs T = Srcs U"
         using TU sources_char\<^sub>P T arr_iff_has_source by auto
       moreover have "Srcs U = Srcs U'"
         by (metis Con_imp_eq_Srcs T TU con_char con_imp_coinitial_ax con_sym in_sourcesE
             in_sourcesI arr_def sources_UU')
       moreover have "Trgs U = Trgs U'"
         using U U' targets_UU' targets_char
         by (metis (full_types) arr_iff_has_target composable_def composable_iff_seq
             composite_of_arr_target elements_are_arr equals0I seq_char)
       ultimately show "T \<^sup>*\\\<^sup>* U \<approx>\<^sup>*\<^sub>0 T \<^sup>*\\\<^sup>* U'"
         using T U U' Coherent [of T U U'] arr_char by blast
     qed
 
     theorem coherent_normal_extends_to_paths:
     shows "coherent_normal_sub_rts Resid (Collect NPath)"
       ..
 
     lemma Cong\<^sub>0_append_Arr_NPath:
     assumes "T \<noteq> []" and "Arr (T @ U)" and "NPath U"
     shows "Cong\<^sub>0 (T @ U) T"
       using assms
       by (metis Arr.simps(1) Arr_appendE\<^sub>P NPath_implies_Arr append_is_composite_of arrI\<^sub>P
           arr_append_imp_seq composite_of_arr_normal mem_Collect_eq)
 
     lemma Cong_append_NPath_Arr:
     assumes "T \<noteq> []" and "Arr (U @ T)" and "NPath U"
     shows "U @ T \<approx>\<^sup>* T"
       using assms
       by (metis (full_types) Arr.simps(1) Con_Arr_self Con_append(2) Con_implies_Arr(2)
           Con_imp_eq_Srcs composite_of_normal_arr Srcs_Resid append_is_composite_of arr_char
           NPath_implies_Arr mem_Collect_eq seq_char)
 
     subsubsection "Permutation Congruence"
 
     text \<open>
       Here we show that \<open>\<^sup>*\<sim>\<^sup>*\<close> coincides with ``permutation congruence'':
       the least congruence respecting composition that relates \<open>[t, u \ t]\<close> and \<open>[u, t \ u]\<close>
       whenever \<open>t \<frown> u\<close> and that relates \<open>T @ [b]\<close> and \<open>T\<close> whenever \<open>b\<close> is an identity
       such that \<open>seq T [b]\<close>.
     \<close>
 
     inductive PCong
     where "Arr T \<Longrightarrow> PCong T T"
         | "PCong T U \<Longrightarrow> PCong U T"
         | "\<lbrakk>PCong T U; PCong U V\<rbrakk> \<Longrightarrow> PCong T V"
         | "\<lbrakk>seq T U; PCong T T'; PCong U U'\<rbrakk> \<Longrightarrow> PCong (T @ U) (T' @ U')"
         | "\<lbrakk>seq T [b]; R.ide b\<rbrakk> \<Longrightarrow> PCong (T @ [b]) T"
         | "t \<frown> u \<Longrightarrow> PCong [t, u \\ t] [u, t \\ u]"
 
     lemmas PCong.intros(3) [trans]
 
     lemma PCong_append_Ide:
     shows "\<lbrakk>seq T B; Ide B\<rbrakk> \<Longrightarrow> PCong (T @ B) T"
     proof (induct B)
       show "\<lbrakk>seq T []; Ide []\<rbrakk> \<Longrightarrow> PCong (T @ []) T"
         by auto
       fix b B T
       assume ind: "\<lbrakk>seq T B; Ide B\<rbrakk> \<Longrightarrow> PCong (T @ B) T"
       assume seq: "seq T (b # B)"
       assume Ide: "Ide (b # B)"
       have "T @ (b # B) = (T @ [b]) @ B"
         by simp
       also have "PCong ... (T @ B)"
         apply (cases "B = []")
         using Ide PCong.intros(5) seq apply force
         using seq Ide PCong.intros(4) [of "T @ [b]" B T B]
         by (metis Arr.simps(1) Ide_imp_Ide_hd PCong.intros(1) PCong.intros(5)
             append_is_Nil_conv arr_append arr_append_imp_seq arr_char calculation
             list.distinct(1) list.sel(1) seq_char)
       also have "PCong (T @ B) T"
       proof (cases "B = []")
         show "B = [] \<Longrightarrow> ?thesis"
           using PCong.intros(1) seq seq_char by force
         assume B: "B \<noteq> []"
         have "seq T B"
           using B seq Ide
           by (metis Con_imp_eq_Srcs Ide_imp_Ide_hd Trgs_append \<open>T @ b # B = (T @ [b]) @ B\<close>
               append_is_Nil_conv arr_append arr_append_imp_seq arr_char cong_cons_ideI(2)
               list.distinct(1) list.sel(1) not_arr_null null_char seq_char ide_implies_arr)
         thus ?thesis
           using seq Ide ind
           by (metis Arr.simps(1) Ide.elims(3) Ide.simps(3) seq_char)
       qed
       finally show "PCong (T @ (b # B)) T" by blast
     qed
 
     lemma PCong_imp_Cong:
     shows "PCong T U \<Longrightarrow> T \<^sup>*\<sim>\<^sup>* U"
     proof (induct rule: PCong.induct)
       show "\<And>T. Arr T \<Longrightarrow> T \<^sup>*\<sim>\<^sup>* T"
         using cong_reflexive by blast
       show "\<And>T U. \<lbrakk>PCong T U; T \<^sup>*\<sim>\<^sup>* U\<rbrakk> \<Longrightarrow> U \<^sup>*\<sim>\<^sup>* T"
         by blast
       show "\<And>T U V. \<lbrakk>PCong T U; T \<^sup>*\<sim>\<^sup>* U; PCong U V; U \<^sup>*\<sim>\<^sup>* V\<rbrakk> \<Longrightarrow> T \<^sup>*\<sim>\<^sup>* V"
         using cong_transitive by blast
       show "\<And>T U U' T'. \<lbrakk>seq T U; PCong T T'; T \<^sup>*\<sim>\<^sup>* T'; PCong U U'; U \<^sup>*\<sim>\<^sup>* U'\<rbrakk>
                            \<Longrightarrow> T @ U \<^sup>*\<sim>\<^sup>* T' @ U'"
         using cong_append by simp
       show "\<And>T b. \<lbrakk>seq T [b]; R.ide b\<rbrakk> \<Longrightarrow> T @ [b] \<^sup>*\<sim>\<^sup>* T"
         using cong_append_ideI(4) ide_char by force
       show "\<And>t u. t \<frown> u \<Longrightarrow> [t, u \\ t] \<^sup>*\<sim>\<^sup>* [u, t \\ u]"
       proof -
         have "\<And>t u. t \<frown> u \<Longrightarrow> [t, u \\ t] \<^sup>*\<lesssim>\<^sup>* [u, t \\ u]"
         proof -
           fix t u
           assume con: "t \<frown> u"
           have "([t] @ [u \\ t]) \<^sup>*\\\<^sup>* ([u] @ [t \\ u]) =
                 [(t \\ u) \\ (t \\ u), ((u \\ t) \\ (u \\ t)) \\ ((t \\ u) \\ (t \\ u))]"
             using con Resid_append2 [of "[t]" "[u \\ t]" "[u]" "[t \\ u]"]
             apply simp
             by (metis R.arr_resid_iff_con R.con_target R.conE R.con_sym
                 R.prfx_implies_con R.prfx_reflexive R.cube)
           moreover have "Ide ..."
             using con
             by (metis Arr.simps(2) Arr.simps(3) Ide.simps(2) Ide.simps(3) R.arr_resid_iff_con
                 R.con_sym R.resid_ide_arr R.prfx_reflexive calculation Con_imp_Arr_Resid)
           ultimately show"[t, u \\ t] \<^sup>*\<lesssim>\<^sup>* [u, t \\ u]"
             using ide_char by auto
         qed
         thus "\<And>t u. t \<frown> u \<Longrightarrow> [t, u \\ t] \<^sup>*\<sim>\<^sup>* [u, t \\ u]"
           using R.con_sym by blast
       qed
     qed
 
     lemma PCong_permute_single:
-    shows "\<And>t. [t] \<^sup>*\<frown>\<^sup>* U \<Longrightarrow> PCong ([t] @ (U \<^sup>*\\\<^sup>* [t])) (U @ ([t] \<^sup>*\\\<^sup>* U))"
-    proof (induct U)
+    shows "[t] \<^sup>*\<frown>\<^sup>* U \<Longrightarrow> PCong ([t] @ (U \<^sup>*\\\<^sup>* [t])) (U @ ([t] \<^sup>*\\\<^sup>* U))"
+    proof (induct U arbitrary: t)
       show "\<And>t. [t] \<^sup>*\<frown>\<^sup>* [] \<Longrightarrow> PCong ([t] @ [] \<^sup>*\\\<^sup>* [t]) ([] @ [t] \<^sup>*\\\<^sup>* [])"
         by auto
       fix t u U
       assume ind: "\<And>t. [t] \<^sup>*\\\<^sup>* U \<noteq> [] \<Longrightarrow> PCong ([t] @( U \<^sup>*\\\<^sup>* [t])) (U @ ([t] \<^sup>*\\\<^sup>* U))"
       assume con: "[t] \<^sup>*\<frown>\<^sup>* u # U"
       show "PCong ([t] @ (u # U) \<^sup>*\\\<^sup>* [t]) ((u # U) @ [t] \<^sup>*\\\<^sup>* (u # U))"
       proof (cases "U = []")
         show "U = [] \<Longrightarrow> ?thesis"
           by (metis PCong.intros(6) Resid.simps(3) append_Cons append_eq_append_conv2
               append_self_conv con_char con_def con con_sym_ax)
         assume U: "U \<noteq> []"
         show "PCong ([t] @ ((u # U) \<^sup>*\\\<^sup>* [t])) ((u # U) @ ([t] \<^sup>*\\\<^sup>* (u # U)))"
         proof -
           have "[t] @ ((u # U) \<^sup>*\\\<^sup>* [t]) = [t] @ ([u \\ t] @ (U \<^sup>*\\\<^sup>* [t \\ u]))"
             using Con_sym Resid_rec(2) U con by auto
           also have "... = ([t] @ [u \\ t]) @ (U \<^sup>*\\\<^sup>* [t \\ u])"
             by auto
           also have "PCong ... (([u] @ [t \\ u]) @ (U \<^sup>*\\\<^sup>* [t \\ u]))"
           proof -
             have "PCong ([t] @ [u \\ t]) ([u] @ [t \\ u])"
               using con
               by (simp add: Con_rec(3) PCong.intros(6) U)  
             thus ?thesis
               by (metis Arr_Resid_single Con_implies_Arr(1) Con_rec(2) Con_sym
                   PCong.intros(1,4) Srcs_Resid U append_is_Nil_conv append_is_composite_of
                   arr_append_imp_seq arr_char calculation composite_of_unq_upto_cong
                   con not_arr_null null_char ide_implies_arr seq_char)
           qed
           also have "([u] @ [t \\ u]) @ (U \<^sup>*\\\<^sup>* [t \\ u]) = [u] @ ([t \\ u] @ (U \<^sup>*\\\<^sup>* [t \\ u]))"
             by simp
           also have "PCong ... ([u] @ (U @ ([t \\ u] \<^sup>*\\\<^sup>* U)))"
           proof -
             have "PCong ([t \\ u] @ (U \<^sup>*\\\<^sup>* [t \\ u])) (U @ ([t \\ u] \<^sup>*\\\<^sup>* U))"
               using ind
               by (metis Resid_rec(3) U con)
             moreover have "seq [u] ([t \\ u] @ U \<^sup>*\\\<^sup>* [t \\ u])"
             proof
               show "Arr [u]"
                 using Con_implies_Arr(2) Con_initial_right con by blast
               show "Arr ([t \\ u] @ U \<^sup>*\\\<^sup>* [t \\ u])"
                 using Con_implies_Arr(1) U con Con_imp_Arr_Resid Con_rec(3) Con_sym
                 by fastforce
               show "Trgs [u] \<inter> Srcs ([t \\ u] @ U \<^sup>*\\\<^sup>* [t \\ u]) \<noteq> {}"
                 by (metis Arr.simps(1) Arr.simps(2) Arr_has_Trg Con_implies_Arr(1)
                     Int_absorb R.arr_resid_iff_con R.sources_resid Resid_rec(3)
                     Srcs.simps(2) Srcs_append Trgs.simps(2) U \<open>Arr [u]\<close> con)
             qed
             moreover have "PCong [u] [u]"
               using PCong.intros(1) calculation(2) seq_char by force
             ultimately show ?thesis
               using U arr_append arr_char con seq_char
                     PCong.intros(4) [of "[u]" "[t \\ u] @ (U \<^sup>*\\\<^sup>* [t \\ u])"
                                         "[u]" "U @ ([t \\ u] \<^sup>*\\\<^sup>* U)"]
               by blast
           qed
           also have "([u] @ (U @ ([t \\ u] \<^sup>*\\\<^sup>* U))) = ((u # U) @ [t] \<^sup>*\\\<^sup>* (u # U))"
             by (metis Resid_rec(3) U append_Cons append_Nil con)
           finally show ?thesis by blast
         qed
       qed
     qed
 
     lemma PCong_permute:
-    shows "\<And>U. T \<^sup>*\<frown>\<^sup>* U \<Longrightarrow> PCong (T @ (U \<^sup>*\\\<^sup>* T)) (U @ (T \<^sup>*\\\<^sup>* U))"
-    proof (induct T)
+    shows "T \<^sup>*\<frown>\<^sup>* U \<Longrightarrow> PCong (T @ (U \<^sup>*\\\<^sup>* T)) (U @ (T \<^sup>*\\\<^sup>* U))"
+    proof (induct T arbitrary: U)
       show "\<And>U. [] \<^sup>*\\\<^sup>* U \<noteq> [] \<Longrightarrow> PCong ([] @ U \<^sup>*\\\<^sup>* []) (U @ [] \<^sup>*\\\<^sup>* U)"
          by simp
       fix t T U
       assume ind: "\<And>U. T \<^sup>*\<frown>\<^sup>* U \<Longrightarrow> PCong (T @ (U \<^sup>*\\\<^sup>* T)) (U @ (T \<^sup>*\\\<^sup>* U))"
       assume con: "t # T \<^sup>*\<frown>\<^sup>* U"
       show "PCong ((t # T) @ (U \<^sup>*\\\<^sup>* (t # T))) (U @ ((t # T) \<^sup>*\\\<^sup>* U))"
       proof (cases "T = []")
         assume T: "T = []"
         have "(t # T) @ (U \<^sup>*\\\<^sup>* (t # T)) = [t] @ (U \<^sup>*\\\<^sup>* [t])"
           using con T by simp
         also have "PCong ... (U @ ([t] \<^sup>*\\\<^sup>* U))"
           using PCong_permute_single T con by blast
         finally show ?thesis
           using T by fastforce
         next
         assume T: "T \<noteq> []"
         have "(t # T) @ (U \<^sup>*\\\<^sup>* (t # T)) = [t] @ (T @ (U \<^sup>*\\\<^sup>* (t # T)))"
           by simp
         also have "PCong ... ([t] @ (U \<^sup>*\\\<^sup>* [t]) @ (T \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* [t])))"
           using ind [of "U \<^sup>*\\\<^sup>* [t]"]
           by (metis Arr.simps(1) Con_imp_Arr_Resid Con_implies_Arr(2) Con_sym
               PCong.intros(1,4) Resid_cons(2) Srcs_Resid T arr_append arr_append_imp_seq
               calculation con not_arr_null null_char seq_char)
         also have "[t] @ (U \<^sup>*\\\<^sup>* [t]) @ (T \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* [t])) =
                    ([t] @ (U \<^sup>*\\\<^sup>* [t])) @ (T \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* [t]))"
           by simp
         also have "PCong (([t] @ (U \<^sup>*\\\<^sup>* [t])) @ (T \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* [t])))
                          ((U @ ([t] \<^sup>*\\\<^sup>* U)) @ (T \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* [t])))"
           by (metis Arr.simps(1) Con_cons(1) Con_imp_Arr_Resid Con_implies_Arr(2)
               PCong.intros(1,4) PCong_permute_single Srcs_Resid T Trgs_append arr_append
               arr_char con seq_char)
         also have "(U @ ([t] \<^sup>*\\\<^sup>* U)) @ (T \<^sup>*\\\<^sup>* (U \<^sup>*\\\<^sup>* [t])) = U @ ((t # T) \<^sup>*\\\<^sup>* U)"
           by (metis Resid.simps(2) Resid_cons(1) append.assoc con)
         finally show ?thesis by blast
       qed
     qed
 
     lemma Cong_imp_PCong:
     assumes "T \<^sup>*\<sim>\<^sup>* U"
     shows "PCong T U"
     proof -
       have "PCong T (T @ (U \<^sup>*\\\<^sup>* T))"
         using assms PCong.intros(2) PCong_append_Ide
         by (metis Con_implies_Arr(1) Ide.simps(1) Srcs_Resid ide_char Con_imp_Arr_Resid
             seq_char)
       also have "PCong (T @ (U \<^sup>*\\\<^sup>* T)) (U @ (T \<^sup>*\\\<^sup>* U))"
         using PCong_permute assms con_char prfx_implies_con by presburger
       also have "PCong (U @ (T \<^sup>*\\\<^sup>* U)) U"
         using assms PCong_append_Ide
         by (metis Con_imp_Arr_Resid Con_implies_Arr(1) Srcs_Resid arr_resid_iff_con
             ide_implies_arr con_char ide_char seq_char)
       finally show ?thesis by blast
     qed
 
     lemma Cong_iff_PCong:
     shows "T \<^sup>*\<sim>\<^sup>* U \<longleftrightarrow> PCong T U"
       using PCong_imp_Cong Cong_imp_PCong by blast
 
   end
 
   section "Composite Completion"
 
   text \<open>
     The RTS of paths in an RTS factors via the coherent normal sub-RTS of identity
     paths into an extensional RTS with composites, which can be regarded as a
     ``composite completion'' of the original RTS.
   \<close>
 
   locale composite_completion =
     R: rts
   begin
 
     interpretation N: coherent_normal_sub_rts resid \<open>Collect R.ide\<close>
       using R.rts_axioms R.identities_form_coherent_normal_sub_rts by auto
     sublocale P: paths_in_rts_with_coherent_normal resid \<open>Collect R.ide\<close> ..
     sublocale quotient_by_coherent_normal P.Resid \<open>Collect P.NPath\<close> ..
 
     notation P.Resid  (infix "\<^sup>*\\\<^sup>*" 70)
     notation P.Con    (infix "\<^sup>*\<frown>\<^sup>*" 50)
     notation P.Cong   (infix "\<^sup>*\<approx>\<^sup>*" 50)
     notation P.Cong\<^sub>0  (infix "\<^sup>*\<approx>\<^sub>0\<^sup>*" 50)
     notation P.Cong_class ("\<lbrace>_\<rbrace>")
 
     notation Resid    (infix "\<lbrace>\<^sup>*\\\<^sup>*\<rbrace>" 70)
     notation con      (infix "\<lbrace>\<^sup>*\<frown>\<^sup>*\<rbrace>" 50)
     notation prfx     (infix "\<lbrace>\<^sup>*\<lesssim>\<^sup>*\<rbrace>" 50)
 
     lemma NPath_char:
     shows "P.NPath T \<longleftrightarrow> P.Ide T"
       using P.NPath_def P.Ide_implies_NPath by blast
 
     lemma Cong_eq_Cong\<^sub>0:
     shows "T \<^sup>*\<approx>\<^sup>* T' \<longleftrightarrow> T \<^sup>*\<approx>\<^sub>0\<^sup>* T'"
       by (metis P.Cong_iff_cong P.ide_char P.ide_closed CollectD Collect_cong
           NPath_char)
 
     lemma Srcs_respects_Cong:
     assumes "T \<^sup>*\<approx>\<^sup>* T'"
     shows "P.Srcs T = P.Srcs T'"
       using assms
       by (meson P.Con_imp_eq_Srcs P.Cong\<^sub>0_imp_con P.con_char Cong_eq_Cong\<^sub>0)
 
     lemma sources_respects_Cong:
     assumes "T \<^sup>*\<approx>\<^sup>* T'"
     shows "P.sources T = P.sources T'"
       using assms
       by (meson P.Cong\<^sub>0_imp_coinitial Cong_eq_Cong\<^sub>0)
 
     lemma Trgs_respects_Cong:
     assumes "T \<^sup>*\<approx>\<^sup>* T'"
     shows "P.Trgs T = P.Trgs T'"
     proof -
       have "P.Trgs T = P.Trgs (T @ (T' \<^sup>*\\\<^sup>* T))"
         using assms NPath_char P.Arr.simps(1) P.Con_imp_Arr_Resid
               P.Con_sym P.Cong_def P.Con_Arr_self
               P.Con_implies_Arr(2) P.Resid_Ide(1) P.Srcs_Resid P.Trgs_append
         by (metis P.Cong\<^sub>0_imp_con P.con_char CollectD)
       also have "... = P.Trgs (T' @ (T \<^sup>*\\\<^sup>* T'))"
         using P.Cong\<^sub>0_imp_con P.con_char Cong_eq_Cong\<^sub>0 assms by force
       also have "... = P.Trgs T'"
         using assms NPath_char P.Arr.simps(1) P.Con_imp_Arr_Resid
               P.Con_sym P.Cong_def P.Con_Arr_self
               P.Con_implies_Arr(2) P.Resid_Ide(1) P.Srcs_Resid P.Trgs_append
         by (metis P.Cong\<^sub>0_imp_con P.con_char CollectD)
       finally show ?thesis by blast
     qed
 
     lemma targets_respects_Cong:
     assumes "T \<^sup>*\<approx>\<^sup>* T'"
     shows "P.targets T = P.targets T'"
       using assms P.Cong_imp_arr(1) P.Cong_imp_arr(2) P.arr_iff_has_target
             P.targets_char\<^sub>P Trgs_respects_Cong
       by force
 
     lemma ide_char\<^sub>C\<^sub>C:
     shows "ide \<T> \<longleftrightarrow> arr \<T> \<and> (\<forall>T. T \<in> \<T> \<longrightarrow> P.Ide T)"
       using NPath_char ide_char' by force
 
     lemma con_char\<^sub>C\<^sub>C:
     shows "\<T> \<lbrace>\<^sup>*\<frown>\<^sup>*\<rbrace> \<U> \<longleftrightarrow> arr \<T> \<and> arr \<U> \<and> P.Cong_class_rep \<T> \<^sup>*\<frown>\<^sup>* P.Cong_class_rep \<U>"
     proof
       show "arr \<T> \<and> arr \<U> \<and> P.Cong_class_rep \<T> \<^sup>*\<frown>\<^sup>* P.Cong_class_rep \<U> \<Longrightarrow> \<T> \<lbrace>\<^sup>*\<frown>\<^sup>*\<rbrace> \<U>"
         using arr_char P.con_char
         by (meson P.rep_in_Cong_class con_char\<^sub>Q\<^sub>C\<^sub>N)
       show "\<T> \<lbrace>\<^sup>*\<frown>\<^sup>*\<rbrace> \<U> \<Longrightarrow> arr \<T> \<and> arr \<U> \<and> P.Cong_class_rep \<T> \<^sup>*\<frown>\<^sup>* P.Cong_class_rep \<U>"
       proof -
         assume con: "\<T> \<lbrace>\<^sup>*\<frown>\<^sup>*\<rbrace> \<U>"
         have 1: "arr \<T> \<and> arr \<U>"
           using con coinitial_iff con_imp_coinitial by blast
         moreover have "P.Cong_class_rep \<T> \<^sup>*\<frown>\<^sup>* P.Cong_class_rep \<U>"
         proof -
           obtain T U where TU: "T \<in> \<T> \<and> U \<in> \<U> \<and> P.Con T U"
             using con Resid_def
             by (meson P.con_char con_char\<^sub>Q\<^sub>C\<^sub>N)
           have "T \<^sup>*\<approx>\<^sup>* P.Cong_class_rep \<T> \<and> U \<^sup>*\<approx>\<^sup>* P.Cong_class_rep \<U>"
             using TU 1 by (meson P.Cong_class_memb_Cong_rep arr_char)
           thus ?thesis
             using TU P.Cong_subst(1) [of T "P.Cong_class_rep \<T>" U "P.Cong_class_rep \<U>"]
             by (metis P.coinitial_iff P.con_char P.con_imp_coinitial sources_respects_Cong)
         qed
         ultimately show ?thesis by simp
       qed
     qed
 
     lemma con_char\<^sub>C\<^sub>C':
     shows "\<T> \<lbrace>\<^sup>*\<frown>\<^sup>*\<rbrace> \<U> \<longleftrightarrow> arr \<T> \<and> arr \<U> \<and> (\<forall>T U. T \<in> \<T> \<and> U \<in> \<U> \<longrightarrow> T \<^sup>*\<frown>\<^sup>* U)"
     proof
       show "arr \<T> \<and> arr \<U> \<and> (\<forall>T U. T \<in> \<T> \<and> U \<in> \<U> \<longrightarrow> T \<^sup>*\<frown>\<^sup>* U) \<Longrightarrow> \<T> \<lbrace>\<^sup>*\<frown>\<^sup>*\<rbrace> \<U>"
         using con_char\<^sub>C\<^sub>C
         by (simp add: P.rep_in_Cong_class arr_char)
       show "\<T> \<lbrace>\<^sup>*\<frown>\<^sup>*\<rbrace> \<U> \<Longrightarrow> arr \<T> \<and> arr \<U> \<and> (\<forall>T U. T \<in> \<T> \<and> U \<in> \<U> \<longrightarrow> T \<^sup>*\<frown>\<^sup>* U)"
       proof (intro conjI allI impI)
         assume 1: "\<T> \<lbrace>\<^sup>*\<frown>\<^sup>*\<rbrace> \<U>"
         show "arr \<T>"
           using 1 con_implies_arr by simp
         show "arr \<U>"
           using 1 con_implies_arr by simp
         fix T U
         assume 2: "T \<in> \<T> \<and> U \<in> \<U>"
         show "T \<^sup>*\<frown>\<^sup>* U"
           using 1 2 P.Cong_class_memb_Cong_rep
           by (meson P.Cong\<^sub>0_subst_Con P.con_char Cong_eq_Cong\<^sub>0 arr_char con_char\<^sub>C\<^sub>C)
       qed
     qed
 
     lemma resid_char:
     shows "\<T> \<lbrace>\<^sup>*\\\<^sup>*\<rbrace> \<U> =
            (if \<T> \<lbrace>\<^sup>*\<frown>\<^sup>*\<rbrace> \<U> then \<lbrace>P.Cong_class_rep \<T> \<^sup>*\\\<^sup>* P.Cong_class_rep \<U>\<rbrace> else {})"
       by (metis P.con_char P.rep_in_Cong_class Resid_by_members arr_char arr_resid_iff_con
           con_char\<^sub>C\<^sub>C is_Cong_class_Resid)
 
     lemma src_char':
     shows "src \<T> = {A. arr \<T> \<and> P.Ide A \<and> P.Srcs (P.Cong_class_rep \<T>) = P.Srcs A}"
     proof (cases "arr \<T>")
       show "\<not> arr \<T> \<Longrightarrow> ?thesis"
         by (simp add: null_char src_def)
       assume \<T>: "arr \<T>"
       have 1: "\<exists>A. P.Ide A \<and> P.Srcs (P.Cong_class_rep \<T>) = P.Srcs A"
         by (metis P.Arr.simps(1) P.Con_imp_eq_Srcs P.Cong\<^sub>0_imp_con
             P.Cong_class_memb_Cong_rep P.Cong_def P.con_char P.rep_in_Cong_class
             CollectD \<T> NPath_char P.Con_implies_Arr(1) arr_char)
       let ?A = "SOME A. P.Ide A \<and> P.Srcs (P.Cong_class_rep \<T>) = P.Srcs A"
       have A: "P.Ide ?A \<and> P.Srcs (P.Cong_class_rep \<T>) = P.Srcs ?A"
         using 1 someI_ex [of "\<lambda>A. P.Ide A \<and> P.Srcs (P.Cong_class_rep \<T>) = P.Srcs A"] by simp
       have a: "arr \<lbrace>?A\<rbrace>"
         using A P.ide_char P.is_Cong_classI arr_char by blast
       have ide_a: "ide \<lbrace>?A\<rbrace>"
         using a A P.Cong_class_def P.normal_is_Cong_closed NPath_char ide_char\<^sub>C\<^sub>C by auto
       have "sources \<T> = {\<lbrace>?A\<rbrace>}"
       proof -
         have "\<T> \<lbrace>\<^sup>*\<frown>\<^sup>*\<rbrace> \<lbrace>?A\<rbrace>"
           by (metis (no_types, lifting) A P.Con_Ide_iff P.Cong_class_memb_Cong_rep
               P.Cong_imp_arr(1) P.arr_char P.arr_in_Cong_class P.ide_char
               P.ide_implies_arr P.rep_in_Cong_class Con_char a \<T> P.con_char
               null_char arr_char P.con_sym conI)
         hence "\<lbrace>?A\<rbrace> \<in> sources \<T>"
           using ide_a in_sourcesI by simp
         thus ?thesis
           using sources_char by auto
       qed
       moreover have "\<lbrace>?A\<rbrace> = {A. P.Ide A \<and> P.Srcs (P.Cong_class_rep \<T>) = P.Srcs A}"
       proof
         show "{A. P.Ide A \<and> P.Srcs (P.Cong_class_rep \<T>) = P.Srcs A} \<subseteq> \<lbrace>?A\<rbrace>"
           using A P.Cong_class_def P.Cong_closure_props(3) P.Ide_implies_Arr
                 P.ide_closed P.ide_char
           by fastforce
         show "\<lbrace>?A\<rbrace> \<subseteq> {A. P.Ide A \<and> P.Srcs (P.Cong_class_rep \<T>) = P.Srcs A}"
           using a A P.Cong_class_def Srcs_respects_Cong ide_a ide_char\<^sub>C\<^sub>C by blast
       qed
       ultimately show ?thesis
         using \<T> src_in_sources by force
     qed
 
     lemma src_char:
     shows "src \<T> = {A. arr \<T> \<and> P.Ide A \<and> (\<forall>T. T \<in> \<T> \<longrightarrow> P.Srcs T = P.Srcs A)}"
     proof (cases "arr \<T>")
       show "\<not> arr \<T> \<Longrightarrow> ?thesis"
         by (simp add: null_char src_def)
       assume \<T>: "arr \<T>"
       have "\<And>T. T \<in> \<T> \<Longrightarrow> P.Srcs T = P.Srcs (P.Cong_class_rep \<T>)"
         using \<T> P.Cong_class_memb_Cong_rep Srcs_respects_Cong arr_char by auto
       thus ?thesis
         using \<T> src_char' P.is_Cong_class_def arr_char by force
     qed
 
     lemma trg_char':
     shows "trg \<T> = {B. arr \<T> \<and> P.Ide B \<and> P.Trgs (P.Cong_class_rep \<T>) = P.Srcs B}"
     proof (cases "arr \<T>")
       show "\<not> arr \<T> \<Longrightarrow> ?thesis"
         by (metis (no_types, lifting) Collect_empty_eq arrI resid_arr_self resid_char)
       assume \<T>: "arr \<T>"
       have 1: "\<exists>B. P.Ide B \<and> P.Trgs (P.Cong_class_rep \<T>) = P.Srcs B"
         by (metis P.Con_implies_Arr(2) P.Resid_Arr_self P.Srcs_Resid \<T> con_char\<^sub>C\<^sub>C arrE)
       define B where "B = (SOME B. P.Ide B \<and> P.Trgs (P.Cong_class_rep \<T>) = P.Srcs B)"
       have B: "P.Ide B \<and> P.Trgs (P.Cong_class_rep \<T>) = P.Srcs B"
         unfolding B_def
         using 1 someI_ex [of "\<lambda>B. P.Ide B \<and> P.Trgs (P.Cong_class_rep \<T>) = P.Srcs B"] by simp
       hence 2: "P.Ide B \<and> P.Con (P.Resid (P.Cong_class_rep \<T>) (P.Cong_class_rep \<T>)) B"
         using \<T>
         by (metis (no_types, lifting) P.Con_Ide_iff P.Ide_implies_Arr P.Resid_Arr_self
             P.Srcs_Resid arrE P.Con_implies_Arr(2) con_char\<^sub>C\<^sub>C)
       have b: "arr \<lbrace>B\<rbrace>"
         by (simp add: "2" P.ide_char P.is_Cong_classI arr_char)
       have ide_b: "ide \<lbrace>B\<rbrace>"
         by (meson "2" P.arr_in_Cong_class P.ide_char P.ide_closed
             b disjoint_iff ide_char P.ide_implies_arr)
       have "targets \<T> = {\<lbrace>B\<rbrace>}"
       proof -
         have "cong (\<T> \<lbrace>\<^sup>*\\\<^sup>*\<rbrace> \<T>) \<lbrace>B\<rbrace>"
         proof -
           have "\<T> \<lbrace>\<^sup>*\\\<^sup>*\<rbrace> \<T> = \<lbrace>B\<rbrace>"
             by (metis (no_types, lifting) "2" P.Cong_class_eqI P.Cong_closure_props(3)
                 P.Resid_Arr_Ide_ind P.Resid_Ide(1) NPath_char \<T> con_char\<^sub>C\<^sub>C resid_char
                 P.Con_implies_Arr(2) P.Resid_Arr_self mem_Collect_eq)
           thus ?thesis
             using b cong_reflexive by presburger
         qed
         thus ?thesis
           using \<T> targets_char\<^sub>Q\<^sub>C\<^sub>N [of \<T>] cong_char by auto
       qed 
       moreover have "\<lbrace>B\<rbrace> = {B. P.Ide B \<and> P.Trgs (P.Cong_class_rep \<T>) = P.Srcs B}"
       proof
         show "{B. P.Ide B \<and> P.Trgs (P.Cong_class_rep \<T>) = P.Srcs B} \<subseteq> \<lbrace>B\<rbrace>"
           using B P.Cong_class_def P.Cong_closure_props(3) P.Ide_implies_Arr
                 P.ide_closed P.ide_char
           by force
         show "\<lbrace>B\<rbrace> \<subseteq> {B. P.Ide B \<and> P.Trgs (P.Cong_class_rep \<T>) = P.Srcs B}"
         proof -
           have "\<And>B'. P.Cong B' B \<Longrightarrow> P.Ide B' \<and> P.Trgs (P.Cong_class_rep \<T>) = P.Srcs B'"
             using B NPath_char P.normal_is_Cong_closed Srcs_respects_Cong
             by (metis P.Cong_closure_props(1) mem_Collect_eq)
           thus ?thesis
             using P.Cong_class_def by blast
         qed
       qed
       ultimately show ?thesis
         using \<T> trg_in_targets by force
     qed
 
     lemma trg_char:
     shows "trg \<T> = {B. arr \<T> \<and> P.Ide B \<and> (\<forall>T. T \<in> \<T> \<longrightarrow> P.Trgs T = P.Srcs B)}"
     proof (cases "arr \<T>")
       show "\<not> arr \<T> \<Longrightarrow> ?thesis"
         using trg_char' by presburger
       assume \<T>: "arr \<T>"
       have "\<And>T. T \<in> \<T> \<Longrightarrow> P.Trgs T = P.Trgs (P.Cong_class_rep \<T>)"
         using \<T>
         by (metis P.Cong_class_memb_Cong_rep Trgs_respects_Cong arr_char)
       thus ?thesis
         using \<T> trg_char' P.is_Cong_class_def arr_char by force
     qed
 
     lemma is_extensional_rts_with_composites:
     shows "extensional_rts_with_composites Resid"
     proof
       fix \<T> \<U>
       assume seq: "seq \<T> \<U>"
       obtain T where T: "\<T> = \<lbrace>T\<rbrace>"
         using seq P.Cong_class_rep arr_char seq_def by blast
       obtain U where U: "\<U> = \<lbrace>U\<rbrace>"
         using seq P.Cong_class_rep arr_char seq_def by blast
       have 1: "P.Arr T \<and> P.Arr U"
         using seq T U P.Con_implies_Arr(2) P.Cong\<^sub>0_subst_right(1) P.Cong_class_def
               P.con_char seq_def
         by (metis Collect_empty_eq P.Cong_imp_arr(1) P.arr_char P.rep_in_Cong_class
             empty_iff arr_char)
       have 2: "P.Trgs T = P.Srcs U"
       proof -
         have "targets \<T> = sources \<U>"
           using seq seq_def sources_char targets_char\<^sub>W\<^sub>E by force
         hence 3: "trg \<T> = src \<U>"
           using seq arr_has_un_source arr_has_un_target
           by (metis seq_def src_in_sources trg_in_targets)
         hence "{B. P.Ide B \<and> P.Trgs (P.Cong_class_rep \<T>) = P.Srcs B} =
                {A. P.Ide A \<and> P.Srcs (P.Cong_class_rep \<U>) = P.Srcs A}"
           using seq seq_def src_char' [of \<U>] trg_char' [of \<T>] by force
         hence "P.Trgs (P.Cong_class_rep \<T>) = P.Srcs (P.Cong_class_rep \<U>)"
           using seq seq_def arr_char
           by (metis (mono_tags, lifting) "3" P.Cong_class_is_nonempty Collect_empty_eq
               arr_src_iff_arr mem_Collect_eq trg_char')
         thus ?thesis
           using seq seq_def arr_char T U P.Srcs_respects_Cong P.Trgs_respects_Cong
                 P.Cong_class_memb_Cong_rep P.Cong_symmetric
           by (metis "1" P.arr_char P.arr_in_Cong_class Srcs_respects_Cong Trgs_respects_Cong)
       qed
       have "P.Arr (T @ U)"
         using 1 2 by simp
       moreover have "P.Ide (T \<^sup>*\\\<^sup>* (T @ U))"
         by (metis "1" P.Con_append(2) P.Con_sym P.Resid_Arr_self P.Resid_Ide_Arr_ind
             P.Resid_append(2) P.Trgs.simps(1) calculation P.Arr_has_Trg)
       moreover have "(T @ U) \<^sup>*\\\<^sup>* T \<^sup>*\<approx>\<^sup>* U"
         by (metis "1" P.Arr.simps(1) P.Con_sym P.Cong\<^sub>0_append_resid_NPath P.Cong\<^sub>0_cancel_left\<^sub>C\<^sub>S
             P.Ide.simps(1) calculation(2) Cong_eq_Cong\<^sub>0 NPath_char)
       ultimately have "composite_of \<T> \<U> \<lbrace>T @ U\<rbrace>"
       proof (unfold composite_of_def, intro conjI)
         show "prfx \<T> (P.Cong_class (T @ U))"
         proof -
           have "ide (\<T> \<lbrace>\<^sup>*\\\<^sup>*\<rbrace> \<lbrace>T @ U\<rbrace>)"
           proof (unfold ide_char, intro conjI)
             have 3: "T \<^sup>*\\\<^sup>* (T @ U) \<in> \<T> \<lbrace>\<^sup>*\\\<^sup>*\<rbrace> \<lbrace>T @ U\<rbrace>"
             proof -
               have "\<T> \<lbrace>\<^sup>*\\\<^sup>*\<rbrace> \<lbrace>T @ U\<rbrace> = \<lbrace>T \<^sup>*\\\<^sup>* (T @ U)\<rbrace>"
                 by (metis "1" P.Ide.simps(1) P.arr_char P.arr_in_Cong_class P.con_char
                     P.is_Cong_classI Resid_by_members T \<open>P.Arr (T @ U)\<close>
                     \<open>P.Ide (T \<^sup>*\\<^sup>* (T @ U))\<close>)
               thus ?thesis
                 by (simp add: P.arr_in_Cong_class P.elements_are_arr NPath_char
                               \<open>P.Ide (T \<^sup>*\\<^sup>* (T @ U))\<close>)
             qed
             show "arr (\<T> \<lbrace>\<^sup>*\\\<^sup>*\<rbrace> \<lbrace>T @ U\<rbrace>)"
               using 3 arr_char is_Cong_class_Resid by blast
             show "\<T> \<lbrace>\<^sup>*\\\<^sup>*\<rbrace> \<lbrace>T @ U\<rbrace> \<inter> Collect P.NPath \<noteq> {}"
               using 3 P.ide_closed P.ide_char \<open>P.Ide (T \<^sup>*\\<^sup>* (T @ U))\<close> by blast
           qed
           thus ?thesis by blast
         qed
         show "\<lbrace>T @ U\<rbrace> \<lbrace>\<^sup>*\\\<^sup>*\<rbrace> \<T> \<lbrace>\<^sup>*\<lesssim>\<^sup>*\<rbrace> \<U>"
         proof -
           have 3: "((T @ U) \<^sup>*\\\<^sup>* T) \<^sup>*\\\<^sup>* U \<in> (\<lbrace>T @ U\<rbrace> \<lbrace>\<^sup>*\\\<^sup>*\<rbrace> \<T>) \<lbrace>\<^sup>*\\\<^sup>*\<rbrace> \<U>"
           proof -
             have "(\<lbrace>T @ U\<rbrace> \<lbrace>\<^sup>*\\\<^sup>*\<rbrace> \<T>) \<lbrace>\<^sup>*\\\<^sup>*\<rbrace> \<U> = \<lbrace>((T @ U) \<^sup>*\\\<^sup>* T) \<^sup>*\\\<^sup>* U\<rbrace>"
             proof -
               have "\<lbrace>T @ U\<rbrace> \<lbrace>\<^sup>*\\\<^sup>*\<rbrace> \<T> = \<lbrace>(T @ U) \<^sup>*\\\<^sup>* T\<rbrace>"
                 by (metis "1" P.Cong_imp_arr(1) P.arr_char P.arr_in_Cong_class
                     P.is_Cong_classI T \<open>P.Arr (T @ U)\<close> \<open>(T @ U) \<^sup>*\\<^sup>* T \<^sup>*\<approx>\<^sup>* U\<close>
                     Resid_by_members P.arr_resid_iff_con)
               moreover
               have "\<lbrace>(T @ U) \<^sup>*\\\<^sup>* T\<rbrace> \<lbrace>\<^sup>*\\\<^sup>*\<rbrace> \<U> = \<lbrace>((T @ U) \<^sup>*\\\<^sup>* T) \<^sup>*\\\<^sup>* U\<rbrace>"
                 by (metis "1" P.Cong_class_eqI P.Cong_imp_arr(1) P.arr_char
                     P.arr_in_Cong_class P.con_char P.is_Cong_classI arr_char arrE U
                     \<open>(T @ U) \<^sup>*\\<^sup>* T \<^sup>*\<approx>\<^sup>* U\<close> con_char\<^sub>C\<^sub>C' Resid_by_members)
               ultimately show ?thesis by auto
             qed
             thus ?thesis
               by (metis "1" P.Arr.simps(1) P.Cong\<^sub>0_reflexive P.Resid_append(2) P.arr_char
                         P.arr_in_Cong_class P.elements_are_arr \<open>P.Arr (T @ U)\<close>)
           qed
           have "\<lbrace>T @ U\<rbrace> \<lbrace>\<^sup>*\\\<^sup>*\<rbrace> \<T> \<lbrace>\<^sup>*\<lesssim>\<^sup>*\<rbrace> \<U>"
           proof (unfold ide_char, intro conjI)
             show "arr ((\<lbrace>T @ U\<rbrace> \<lbrace>\<^sup>*\\\<^sup>*\<rbrace> \<T>) \<lbrace>\<^sup>*\\\<^sup>*\<rbrace> \<U>)"
               using 3 arr_char is_Cong_class_Resid by blast
             show "(\<lbrace>T @ U\<rbrace> \<lbrace>\<^sup>*\\\<^sup>*\<rbrace> \<T>) \<lbrace>\<^sup>*\\\<^sup>*\<rbrace> \<U> \<inter> Collect P.NPath \<noteq> {}"
               by (metis 1 3 P.Arr.simps(1) P.Resid_append(2) P.con_char
                   IntI \<open>P.Arr (T @ U)\<close> NPath_char P.Resid_Arr_self P.arr_char empty_iff
                   mem_Collect_eq P.arrE)
           qed
           thus ?thesis by blast
         qed
         show "\<U> \<lbrace>\<^sup>*\<lesssim>\<^sup>*\<rbrace> \<lbrace>T @ U\<rbrace> \<lbrace>\<^sup>*\\\<^sup>*\<rbrace> \<T>"
         proof (unfold ide_char, intro conjI)
           have 3: "U \<^sup>*\\\<^sup>* ((T @ U) \<^sup>*\\\<^sup>* T) \<in> \<U> \<lbrace>\<^sup>*\\\<^sup>*\<rbrace> (\<lbrace>T @ U\<rbrace> \<lbrace>\<^sup>*\\\<^sup>*\<rbrace> \<T>)"
           proof -
             have "\<U> \<lbrace>\<^sup>*\\\<^sup>*\<rbrace> (\<lbrace>T @ U\<rbrace> \<lbrace>\<^sup>*\\\<^sup>*\<rbrace> \<T>) = \<lbrace>U \<^sup>*\\\<^sup>* ((T @ U) \<^sup>*\\\<^sup>* T)\<rbrace>"
             proof -
               have "\<lbrace>T @ U\<rbrace> \<lbrace>\<^sup>*\\\<^sup>*\<rbrace> \<T> = \<lbrace>(T @ U) \<^sup>*\\\<^sup>* T\<rbrace>"
                 by (metis "1" P.Con_sym P.Ide.simps(1) P.arr_char P.arr_in_Cong_class
                     P.con_char P.is_Cong_classI Resid_by_members T \<open>P.Arr (T @ U)\<close>
                     \<open>P.Ide (T \<^sup>*\\<^sup>* (T @ U))\<close>)
               moreover have "\<U> \<lbrace>\<^sup>*\\\<^sup>*\<rbrace> (\<lbrace>T @ U\<rbrace> \<lbrace>\<^sup>*\\\<^sup>*\<rbrace> \<T>) = \<lbrace>U \<^sup>*\\\<^sup>* ((T @ U) \<^sup>*\\\<^sup>* T)\<rbrace>"
                 by (metis "1" P.Cong_class_eqI P.Cong_imp_arr(1) P.arr_char
                     P.arr_in_Cong_class P.con_char P.is_Cong_classI prfx_implies_con
                     U \<open>(T @ U) \<^sup>*\\<^sup>* T \<^sup>*\<approx>\<^sup>* U\<close> \<open>\<lbrace>T @ U\<rbrace> \<lbrace>\<^sup>*\\<^sup>*\<rbrace> \<T> \<lbrace>\<^sup>*\<lesssim>\<^sup>*\<rbrace> \<U>\<close>
                     calculation con_char\<^sub>C\<^sub>C' Resid_by_members)
               ultimately show ?thesis by blast
             qed
             thus ?thesis
               by (metis "1" P.Arr.simps(1) P.Resid_append_ind P.arr_in_Cong_class
                   P.con_char \<open>P.Arr (T @ U)\<close> P.Con_Arr_self P.arr_resid_iff_con)
           qed
           show "arr (\<U> \<lbrace>\<^sup>*\\\<^sup>*\<rbrace> (\<lbrace>T @ U\<rbrace> \<lbrace>\<^sup>*\\\<^sup>*\<rbrace> \<T>))"
             by (metis "3" arr_resid_iff_con empty_iff resid_char)
           show "\<U> \<lbrace>\<^sup>*\\\<^sup>*\<rbrace> (\<lbrace>T @ U\<rbrace> \<lbrace>\<^sup>*\\\<^sup>*\<rbrace> \<T>) \<inter> Collect P.NPath \<noteq> {}"
             by (metis "1" "3" P.Arr.simps(1) P.Cong\<^sub>0_append_resid_NPath P.Cong\<^sub>0_cancel_left\<^sub>C\<^sub>S
                 P.Cong_imp_arr(1) P.arr_char NPath_char IntI \<open>(T @ U) \<^sup>*\\<^sup>* T \<^sup>*\<approx>\<^sup>* U\<close>
                 \<open>P.Ide (T \<^sup>*\\<^sup>* (T @ U))\<close> empty_iff)
         qed
       qed
       thus "composable \<T> \<U>"
         using composable_def by auto
     qed
 
     sublocale extensional_rts_with_composites Resid
       using is_extensional_rts_with_composites by simp
 
     subsection "Inclusion Map"
 
     abbreviation incl
     where "incl t \<equiv> \<lbrace>[t]\<rbrace>"
 
     text \<open>
       The inclusion into the composite completion preserves consistency and residuation.
     \<close>
 
     lemma incl_preserves_con:
     assumes "t \<frown> u"
     shows "\<lbrace>[t]\<rbrace> \<lbrace>\<^sup>*\<frown>\<^sup>*\<rbrace> \<lbrace>[u]\<rbrace>"
       using assms
       by (meson P.Con_rec(1) P.arr_in_Cong_class P.con_char P.is_Cong_classI
           con_char\<^sub>Q\<^sub>C\<^sub>N P.con_implies_arr(1-2))
 
     lemma incl_preserves_resid:
     shows "\<lbrace>[t \\ u]\<rbrace> = \<lbrace>[t]\<rbrace> \<lbrace>\<^sup>*\\\<^sup>*\<rbrace> \<lbrace>[u]\<rbrace>"
     proof (cases "t \<frown> u")
       show "t \<frown> u \<Longrightarrow> ?thesis"
       proof -
         assume 1: "t \<frown> u"
         have "P.is_Cong_class \<lbrace>[t]\<rbrace> \<and> P.is_Cong_class \<lbrace>[u]\<rbrace>"
           using 1 con_char\<^sub>Q\<^sub>C\<^sub>N incl_preserves_con by presburger
         moreover have "[t] \<in> \<lbrace>[t]\<rbrace> \<and> [u] \<in> \<lbrace>[u]\<rbrace>"
           using 1
           by (meson P.Con_rec(1) P.arr_in_Cong_class P.con_char
               P.Con_implies_Arr(2) P.arr_char P.con_implies_arr(1))
         moreover have "P.con [t] [u]"
           using 1 by (simp add: P.con_char)
         ultimately show ?thesis
           using Resid_by_members [of "\<lbrace>[t]\<rbrace>" "\<lbrace>[u]\<rbrace>" "[t]" "[u]"]
           by (simp add: "1")
       qed
       assume 1: "\<not> t \<frown> u"
       have "\<lbrace>[t \\ u]\<rbrace> = {}"
         using 1 R.arrI
         by (metis Collect_empty_eq P.Con_Arr_self P.Con_rec(1)
             P.Cong_class_def P.Cong_imp_arr(1) P.arr_char R.arr_resid_iff_con)
       also have "... = \<lbrace>[t]\<rbrace> \<lbrace>\<^sup>*\\\<^sup>*\<rbrace> \<lbrace>[u]\<rbrace>"
         by (metis (full_types) "1" Con_char CollectD P.Con_rec(1) P.Cong_class_def
             P.Cong_imp_arr(1) P.arr_in_Cong_class con_char\<^sub>C\<^sub>C' null_char conI)
       finally show ?thesis by simp
     qed
 
     lemma incl_reflects_con:
     assumes "\<lbrace>[t]\<rbrace> \<lbrace>\<^sup>*\<frown>\<^sup>*\<rbrace> \<lbrace>[u]\<rbrace>"
     shows "t \<frown> u"
       by (metis P.Con_rec(1) P.Cong_class_def P.Cong_imp_arr(1) P.arr_in_Cong_class
           CollectD assms con_char\<^sub>C\<^sub>C' con_char\<^sub>Q\<^sub>C\<^sub>N)
 
     text \<open>
       The inclusion map is a simulation.
     \<close>
 
     sublocale incl: simulation resid Resid incl
     proof
       show "\<And>t. \<not> R.arr t \<Longrightarrow> incl t = null"
         by (metis Collect_empty_eq P.Cong_class_def P.Cong_imp_arr(1) P.Ide.simps(2)
             P.Resid_rec(1) P.cong_reflexive P.elements_are_arr P.ide_char P.ide_closed
             P.not_arr_null P.null_char R.prfx_implies_con null_char R.con_implies_arr(1))
       show "\<And>t u. t \<frown> u \<Longrightarrow> incl t \<lbrace>\<^sup>*\<frown>\<^sup>*\<rbrace> incl u"
         using incl_preserves_con by blast
       show "\<And>t u. t \<frown> u \<Longrightarrow> incl (t \\ u) = incl t \<lbrace>\<^sup>*\\\<^sup>*\<rbrace> incl u"
         using incl_preserves_resid by blast
     qed
 
     lemma inclusion_is_simulation:
     shows "simulation resid Resid incl"
       ..
 
     lemma incl_preserves_arr:
     assumes "R.arr a"
     shows "arr \<lbrace>[a]\<rbrace>"
       using assms incl_preserves_con by auto
 
     lemma incl_preserves_ide:
     assumes "R.ide a"
     shows "ide \<lbrace>[a]\<rbrace>"
       by (metis assms incl_preserves_con incl_preserves_resid R.ide_def ide_def)
 
     lemma cong_iff_eq_incl:
     assumes "R.arr t" and "R.arr u"
     shows "\<lbrace>[t]\<rbrace> = \<lbrace>[u]\<rbrace> \<longleftrightarrow> t \<sim> u"
     proof
       show "\<lbrace>[t]\<rbrace> = \<lbrace>[u]\<rbrace> \<Longrightarrow> t \<sim> u"
         by (metis P.Con_rec(1) P.Ide.simps(2) P.Resid.simps(3) P.arr_in_Cong_class
             P.con_char R.arr_def R.cong_reflexive assms(1) ide_char\<^sub>C\<^sub>C
             incl_preserves_con incl_preserves_ide incl_preserves_resid incl_reflects_con
             P.arr_resid_iff_con)
       show "t \<sim> u \<Longrightarrow> \<lbrace>[t]\<rbrace> = \<lbrace>[u]\<rbrace>"
         using assms
         by (metis incl_preserves_resid extensional incl_preserves_ide)
     qed
 
     text \<open>
       The inclusion is surjective on identities.
     \<close>
 
     lemma img_incl_ide:
     shows "incl ` (Collect R.ide) = Collect ide"
     proof
       show "incl ` Collect R.ide \<subseteq> Collect ide"
         by (simp add: image_subset_iff)
       show "Collect ide \<subseteq> incl ` Collect R.ide"
       proof
         fix \<A>
         assume \<A>: "\<A> \<in> Collect ide"
         obtain A where A: "A \<in> \<A>"
           using \<A> ide_char by blast
         have "P.NPath A"
           by (metis A Ball_Collect \<A> ide_char' mem_Collect_eq)
         obtain a where a: "a \<in> P.Srcs A"
           using \<open>P.NPath A\<close>
           by (meson P.NPath_implies_Arr equals0I P.Arr_has_Src)
         have "P.Cong\<^sub>0 A [a]"
         proof -
           have "P.Ide [a]"
             by (metis NPath_char P.Con_Arr_self P.Ide.simps(2) P.NPath_implies_Arr
                 P.Resid_Ide(1) P.Srcs.elims R.in_sourcesE \<open>P.NPath A\<close> a)
           thus ?thesis
             using a A
             by (metis P.Ide.simps(2) P.ide_char P.ide_closed \<open>P.NPath A\<close> NPath_char
                 P.Con_single_ide_iff P.Ide_implies_Arr P.Resid_Arr_Ide_ind P.Resid_Arr_Src)
         qed
         have "\<A> = \<lbrace>[a]\<rbrace>"
           by (metis A P.Cong\<^sub>0_imp_con P.Cong\<^sub>0_implies_Cong P.Cong\<^sub>0_transitive P.Cong_class_eqI
               P.ide_char P.resid_arr_ide Resid_by_members \<A> \<open>A \<^sup>*\<approx>\<^sub>0\<^sup>* [a]\<close> \<open>P.NPath A\<close> arr_char
               NPath_char ideE ide_implies_arr mem_Collect_eq)
         thus "\<A> \<in> incl ` Collect R.ide"
           using NPath_char P.Ide.simps(2) P.backward_stable \<open>A \<^sup>*\<approx>\<^sub>0\<^sup>* [a]\<close> \<open>P.NPath A\<close> by blast
       qed
     qed
 
   end
 
   subsection "Composite Completion of an Extensional RTS"
 
   locale composite_completion_of_extensional_rts =
     R: extensional_rts +
     composite_completion
   begin
 
     sublocale P: paths_in_weakly_extensional_rts resid ..
 
     notation comp (infixl "\<lbrace>\<^sup>*\<cdot>\<^sup>*\<rbrace>" 55)
 
     text \<open>
       When applied to an extensional RTS, the composite completion construction does not
       identify any states that are distinct in the original RTS.
     \<close>
 
     lemma incl_injective_on_ide:
     shows "inj_on incl (Collect R.ide)"
       using R.extensional cong_iff_eq_incl
       by (intro inj_onI) auto
 
     text \<open>
       When applied to an extensional RTS, the composite completion construction
       is a bijection between the states of the original RTS and the states of its completion.
     \<close>
 
     lemma incl_bijective_on_ide:
     shows "bij_betw incl (Collect R.ide) (Collect ide)"
       using incl_injective_on_ide img_incl_ide bij_betw_def by blast
 
   end
 
   subsection "Freeness of Composite Completion"
 
   text \<open>
     In this section we show that the composite completion construction is free:
     any simulation from RTS \<open>A\<close> to an extensional RTS with composites \<open>B\<close>
     extends uniquely to a simulation on the composite completion of \<open>A\<close>.
   \<close>
 
   locale extension_of_simulation =
     A: paths_in_rts resid\<^sub>A +
     B: extensional_rts_with_composites resid\<^sub>B +
     F: simulation resid\<^sub>A resid\<^sub>B F
   for resid\<^sub>A :: "'a resid"      (infix "\\\<^sub>A" 70)
   and resid\<^sub>B :: "'b resid"      (infix "\\\<^sub>B" 70)
   and F :: "'a \<Rightarrow> 'b"
   begin
 
     notation A.Resid    (infix "\<^sup>*\\\<^sub>A\<^sup>*" 70)
     notation A.Resid1x  (infix "\<^sup>1\\\<^sub>A\<^sup>*" 70)
     notation A.Residx1  (infix "\<^sup>*\\\<^sub>A\<^sup>1" 70)
     notation A.Con      (infix "\<^sup>*\<frown>\<^sub>A\<^sup>*" 70)
     notation B.comp     (infixl "\<cdot>\<^sub>B" 55)
     notation B.con      (infix "\<frown>\<^sub>B" 50)
 
     fun map
     where "map [] = B.null"
         | "map [t] = F t"
         | "map (t # T) = (if A.arr (t # T) then F t \<cdot>\<^sub>B map T else B.null)"
 
     lemma map_o_incl_eq:
     shows "map (A.incl t) = F t"
       by (simp add: A.null_char F.extensional)
 
     lemma extensional:
     shows "\<not> A.arr T \<Longrightarrow> map T = B.null"
       using F.extensional A.arr_char
       by (metis A.Arr.simps(2) map.elims)
 
     lemma preserves_comp:
-    shows "\<And>U. \<lbrakk>T \<noteq> []; U \<noteq> []; A.Arr (T @ U)\<rbrakk> \<Longrightarrow> map (T @ U) = map T \<cdot>\<^sub>B map U"
-    proof (induct T)
+    shows "\<lbrakk>T \<noteq> []; U \<noteq> []; A.Arr (T @ U)\<rbrakk> \<Longrightarrow> map (T @ U) = map T \<cdot>\<^sub>B map U"
+    proof (induct T arbitrary: U)
       show "\<And>U. [] \<noteq> [] \<Longrightarrow> map ([] @ U) = map [] \<cdot>\<^sub>B map U"
         by simp
       fix t and T U :: "'a list"
       assume ind: "\<And>U. \<lbrakk>T \<noteq> []; U \<noteq> []; A.Arr (T @ U)\<rbrakk>
                           \<Longrightarrow> map (T @ U) = map T \<cdot>\<^sub>B map U"
       assume U: "U \<noteq> []"
       assume Arr: "A.Arr ((t # T) @ U)"
       hence 1: "A.Arr (t # (T @ U))"
         by simp
       have 2: "A.Arr (t # T)"
         by (metis A.Con_Arr_self A.Con_append(1) A.Con_implies_Arr(1) Arr U append_is_Nil_conv
             list.distinct(1))
       show "map ((t # T) @ U) = B.comp (map (t # T)) (map U)"
       proof (cases "T = []")
         show "T = [] \<Longrightarrow> ?thesis"
           by (metis (full_types) "1" A.arr_char U append_Cons append_Nil list.exhaust
               map.simps(2) map.simps(3))
         assume T: "T \<noteq> []"
         have "map ((t # T) @ U) = map (t # (T @ U))"
           by simp
         also have "... = F t \<cdot>\<^sub>B map (T @ U)"
           using T 1
           by (metis A.arr_char Nil_is_append_conv list.exhaust map.simps(3))
         also have "... =  F t \<cdot>\<^sub>B (map T \<cdot>\<^sub>B map U)"
           using ind
           by (metis "1" A.Con_Arr_self A.Con_implies_Arr(1) A.Con_rec(4) T U append_is_Nil_conv)
         also have "... = F t \<cdot>\<^sub>B map T \<cdot>\<^sub>B map U"
           using B.comp_assoc\<^sub>E\<^sub>C by blast
         also have "... = map (t # T) \<cdot>\<^sub>B map U"
           using T 2
           by (metis A.arr_char list.exhaust map.simps(3))
         finally show "map ((t # T) @ U) = map (t # T) \<cdot>\<^sub>B map U" by simp
       qed
     qed
 
     lemma preserves_arr_ind:
-    shows "\<And>a. \<lbrakk>A.arr T; a \<in> A.Srcs T\<rbrakk> \<Longrightarrow> B.arr (map T) \<and> B.src (map T) = F a"
-    proof (induct T)
+    shows "\<lbrakk>A.arr T; a \<in> A.Srcs T\<rbrakk> \<Longrightarrow> B.arr (map T) \<and> B.src (map T) = F a"
+    proof (induct T arbitrary: a)
       show "\<And>a. \<lbrakk>A.arr []; a \<in> A.Srcs []\<rbrakk> \<Longrightarrow> B.arr (map []) \<and> B.src (map []) = F a"
         using A.arr_char by simp
       fix a t T
       assume a: "a \<in> A.Srcs (t # T)"
       assume tT: "A.arr (t # T)"
       assume ind: "\<And>a. \<lbrakk>A.arr T; a \<in> A.Srcs T\<rbrakk> \<Longrightarrow> B.arr (map T) \<and> B.src (map T) = F a"
       have 1: "a \<in> A.R.sources t"
         using a tT A.Con_imp_eq_Srcs A.Con_initial_right A.Srcs.simps(2) A.con_char
         by blast
       show "B.arr (map (t # T)) \<and> B.src (map (t # T)) = F a"
       proof (cases "T = []")
         show "T = [] \<Longrightarrow> ?thesis"
           by (metis "1" A.Arr.simps(2) A.arr_char B.arr_has_un_source B.src_in_sources
               F.preserves_reflects_arr F.preserves_sources image_subset_iff map.simps(2) tT)
         assume T: "T \<noteq> []"
         obtain a' where a': "a' \<in> A.R.targets t"
           using tT "1" A.R.resid_source_in_targets by auto
         have 2: "a' \<in> A.Srcs T"
           using a' tT
           by (metis A.Con_Arr_self A.R.sources_resid A.Srcs.simps(2) A.arr_char T
               A.Con_imp_eq_Srcs A.Con_rec(4))
         have "B.arr (map (t # T)) \<longleftrightarrow> B.arr (F t \<cdot>\<^sub>B map T)"
           using tT T by (metis map.simps(3) neq_Nil_conv)
         also have 2: "... \<longleftrightarrow> True"
           by (metis (no_types, lifting) "2" A.arr_char B.arr_comp\<^sub>E\<^sub>C B.arr_has_un_target
               B.trg_in_targets F.preserves_reflects_arr F.preserves_targets T a'
               A.Arr.elims(2) image_subset_iff ind list.sel(1) list.sel(3) tT)
         finally have "B.arr (map (t # T))" by simp
         moreover have "B.src (map (t # T)) = F a"
         proof -
           have "B.src (map (t # T)) = B.src (F t \<cdot>\<^sub>B map T)"
             using tT T by (metis map.simps(3) neq_Nil_conv)
           also have "... = B.src (F t)"
             using "2" B.con_comp_iff by force
           also have "... = F a"
             by (meson "1" B.weakly_extensional_rts_axioms F.simulation_axioms
                 simulation_to_weakly_extensional_rts.preserves_src
                 simulation_to_weakly_extensional_rts_def)
           finally show ?thesis by simp
         qed
         ultimately show ?thesis by simp
       qed
     qed
 
     lemma preserves_arr:
     shows "A.arr T \<Longrightarrow> B.arr (map T)"
       using preserves_arr_ind A.arr_char A.Arr_has_Src by blast
 
     lemma preserves_src:
     assumes "A.arr T" and "a \<in> A.Srcs T"
     shows "B.src (map T) = F a"
       using assms preserves_arr_ind by simp
 
     lemma preserves_trg:
     shows "\<lbrakk>A.arr T; b \<in> A.Trgs T\<rbrakk> \<Longrightarrow> B.trg (map T) = F b"
     proof (induct T)
       show "\<lbrakk>A.arr []; b \<in> A.Trgs []\<rbrakk> \<Longrightarrow> B.trg (map []) = F b"
         by simp
       fix t T
       assume tT: "A.arr (t # T)"
       assume b: "b \<in> A.Trgs (t # T)"
       assume ind: "\<lbrakk>A.arr T; b \<in> A.Trgs T\<rbrakk> \<Longrightarrow> B.trg (map T) = F b"
       show "B.trg (map (t # T)) = F b"
       proof (cases "T = []")
         show "T = [] \<Longrightarrow> ?thesis"
           using tT b
           by (metis A.Trgs.simps(2) B.arr_has_un_target B.trg_in_targets F.preserves_targets
               preserves_arr image_subset_iff map.simps(2))
         assume T: "T \<noteq> []"
         have 1: "B.trg (map (t # T)) = B.trg (F t \<cdot>\<^sub>B map T)"
           using tT T b
           by (metis map.simps(3) neq_Nil_conv)
         also have "... = B.trg (map T)"
           by (metis B.arr_trg_iff_arr B.composable_iff_arr_comp B.trg_comp calculation
               preserves_arr tT)
         also have "... = F b"
           using tT b ind
           by (metis A.Trgs.simps(3) T A.Arr.simps(3) A.arr_char list.exhaust)
         finally show ?thesis by simp
       qed
     qed
 
     lemma preserves_Resid1x_ind:
-    shows "\<And>t. t \<^sup>1\\\<^sub>A\<^sup>* U \<noteq> A.R.null \<Longrightarrow> F t \<frown>\<^sub>B map U \<and> F (t \<^sup>1\\\<^sub>A\<^sup>* U) = F t \\\<^sub>B map U"
-    proof (induct U)
+    shows "t \<^sup>1\\\<^sub>A\<^sup>* U \<noteq> A.R.null \<Longrightarrow> F t \<frown>\<^sub>B map U \<and> F (t \<^sup>1\\\<^sub>A\<^sup>* U) = F t \\\<^sub>B map U"
+    proof (induct U arbitrary: t)
       show "\<And>t. t \<^sup>1\\\<^sub>A\<^sup>* [] \<noteq> A.R.null \<Longrightarrow> F t \<frown>\<^sub>B map [] \<and> F (t \<^sup>1\\\<^sub>A\<^sup>* []) = F t \\\<^sub>B map []"
         by simp
       fix t u U
       assume uU: "t \<^sup>1\\\<^sub>A\<^sup>* (u # U) \<noteq> A.R.null"
       assume ind: "\<And>t. t \<^sup>1\\\<^sub>A\<^sup>* U \<noteq> A.R.null
                           \<Longrightarrow> F t \<frown>\<^sub>B map U \<and> F (t \<^sup>1\\\<^sub>A\<^sup>* U) = F t \\\<^sub>B map U"
       show "F t \<frown>\<^sub>B map (u # U) \<and> F (t \<^sup>1\\\<^sub>A\<^sup>* (u # U)) = F t \\\<^sub>B map (u # U)"
       proof
         show 1: "F t \<frown>\<^sub>B map (u # U)"
         proof (cases "U = []")
           show "U = [] \<Longrightarrow> ?thesis"
             using A.Resid1x.simps(2) map.simps(2) F.preserves_con uU by fastforce
           assume U: "U \<noteq> []"
           have 3: "[t] \<^sup>*\\\<^sub>A\<^sup>* [u] \<noteq> [] \<and> ([t] \<^sup>*\\\<^sub>A\<^sup>* [u]) \<^sup>*\\\<^sub>A\<^sup>* U \<noteq> []"
             using A.Con_cons(2) [of "[t]" U u]
             by (meson A.Resid1x_as_Resid' U not_Cons_self2 uU)
           hence 2: "F t \<frown>\<^sub>B F u \<and> F t \\\<^sub>B F u \<frown>\<^sub>B map U"
             by (metis A.Con_rec(1) A.Con_sym A.Con_sym1 A.Residx1_as_Resid A.Resid_rec(1)
                 F.preserves_con F.preserves_resid ind)
           moreover have "B.seq (F u) (map U)"
             by (metis B.coinitial_iff\<^sub>W\<^sub>E B.con_imp_coinitial B.seqI\<^sub>W\<^sub>E B.src_resid calculation)
           ultimately have "F t \<frown>\<^sub>B map ([u] @ U)"
             using B.con_comp_iff\<^sub>E\<^sub>C(1) [of "F t" "F u" "map U"] B.con_sym preserves_comp
             by (metis 3 A.Con_cons(2) A.Con_implies_Arr(2)
                 append.left_neutral append_Cons map.simps(2) not_Cons_self2)
           thus ?thesis by simp
         qed
         show "F (t \<^sup>1\\\<^sub>A\<^sup>* (u # U)) = F t \\\<^sub>B map (u # U)"
         proof (cases "U = []")
           show "U = [] \<Longrightarrow> ?thesis"
             using A.Resid1x.simps(2) F.preserves_resid map.simps(2) uU by fastforce
           assume U: "U \<noteq> []"
           have "F (t \<^sup>1\\\<^sub>A\<^sup>* (u # U)) = F ((t \\\<^sub>A u) \<^sup>1\\\<^sub>A\<^sup>* U)"
             using A.Resid1x_as_Resid' A.Resid_rec(3) U uU by metis
           also have "... = F (t \\\<^sub>A u) \\\<^sub>B map U"
             using uU U ind A.Con_rec(3) A.Resid1x_as_Resid [of "t \\\<^sub>A u" U] 
             by (metis A.Resid1x.simps(3) list.exhaust)
           also have "... = (F t \\\<^sub>B F u) \\\<^sub>B map U"
             using uU U
             by (metis A.Resid1x_as_Resid' F.preserves_resid A.Con_rec(3))
           also have "... = F t \\\<^sub>B (F u \<cdot>\<^sub>B map U)"
             by (metis B.comp_null(2) B.composable_iff_comp_not_null B.con_compI(2) B.conI
                 B.con_sym_ax B.mediating_transition B.null_is_zero(2) B.resid_comp(1))
           also have "... = F t \\\<^sub>B map (u # U)"
             by (metis A.Resid1x_as_Resid' A.con_char U map.simps(3) neq_Nil_conv
                 A.con_implies_arr(2) uU)
           finally show ?thesis by simp
         qed
       qed
     qed
 
     lemma preserves_Residx1_ind:
-    shows "\<And>t. U \<^sup>*\\\<^sub>A\<^sup>1 t \<noteq> [] \<Longrightarrow> map U \<frown>\<^sub>B F t \<and> map (U \<^sup>*\\\<^sub>A\<^sup>1 t) = map U \\\<^sub>B F t"
-    proof (induct U)
+    shows "U \<^sup>*\\\<^sub>A\<^sup>1 t \<noteq> [] \<Longrightarrow> map U \<frown>\<^sub>B F t \<and> map (U \<^sup>*\\\<^sub>A\<^sup>1 t) = map U \\\<^sub>B F t"
+    proof (induct U arbitrary: t)
       show "\<And>t. [] \<^sup>*\\\<^sub>A\<^sup>1 t \<noteq> [] \<Longrightarrow> map [] \<frown>\<^sub>B F t \<and> map ([] \<^sup>*\\\<^sub>A\<^sup>1 t) = map [] \\\<^sub>B F t"
         by simp
       fix t u U
       assume ind: "\<And>t. U \<^sup>*\\\<^sub>A\<^sup>1 t \<noteq> [] \<Longrightarrow> map U \<frown>\<^sub>B F t \<and> map (U \<^sup>*\\\<^sub>A\<^sup>1 t) = map U \\\<^sub>B F t"
       assume uU: "(u # U) \<^sup>*\\\<^sub>A\<^sup>1 t \<noteq> []"
       show "map (u # U) \<frown>\<^sub>B F t \<and> map ((u # U) \<^sup>*\\\<^sub>A\<^sup>1 t) = map (u # U) \\\<^sub>B F t"
       proof (cases "U = []")
         show "U = [] \<Longrightarrow> ?thesis"
           using A.Residx1.simps(2) F.preserves_con F.preserves_resid map.simps(2) uU
           by presburger
         assume U: "U \<noteq> []"
         show ?thesis
         proof
           show "map (u # U) \<frown>\<^sub>B F t"
             using uU U A.Con_sym1 B.con_sym preserves_Resid1x_ind by blast
           show "map ((u # U) \<^sup>*\\\<^sub>A\<^sup>1 t) = map (u # U) \\\<^sub>B F t"
           proof -
             have "map ((u # U) \<^sup>*\\\<^sub>A\<^sup>1 t) = map ((u \\\<^sub>A t) # U \<^sup>*\\\<^sub>A\<^sup>1 (t \\\<^sub>A u))"
               using uU U A.Residx1_as_Resid A.Resid_rec(2) by fastforce
             also have "... = F (u \\\<^sub>A t) \<cdot>\<^sub>B map (U \<^sup>*\\\<^sub>A\<^sup>1 (t \\\<^sub>A u))"
               by (metis A.Residx1_as_Resid A.arr_char U A.Con_imp_Arr_Resid
                   A.Con_rec(2) A.Resid_rec(2) list.exhaust map.simps(3) uU)
             also have "... = F (u \\\<^sub>A t) \<cdot>\<^sub>B map U \\\<^sub>B F (t \\\<^sub>A u)"
               using uU U ind A.Con_rec(2) A.Residx1_as_Resid by force
             also have "... = (F u \\\<^sub>B F t) \<cdot>\<^sub>B map U \\\<^sub>B (F t \\\<^sub>B F u)"
               using uU U
               by (metis A.Con_initial_right A.Con_rec(1) A.Con_sym1 A.Resid1x_as_Resid'
                   A.Residx1_as_Resid F.preserves_resid)
             also have "... = (F u \<cdot>\<^sub>B map U) \\\<^sub>B F t"
               by (metis B.comp_null(2) B.composable_iff_comp_not_null B.con_compI(2) B.con_sym
                   B.mediating_transition B.null_is_zero(2) B.resid_comp(2) B.con_def)
             also have "... = map (u # U) \\\<^sub>B F t"
               by (metis A.Con_implies_Arr(2) A.Con_sym A.Residx1_as_Resid U
                   A.arr_char map.simps(3) neq_Nil_conv uU)
             finally show ?thesis by simp
           qed
         qed
       qed
     qed
 
     lemma preserves_resid_ind:
-    shows "\<And>U. A.con T U \<Longrightarrow> map T \<frown>\<^sub>B map U \<and> map (T \<^sup>*\\\<^sub>A\<^sup>* U) = map T \\\<^sub>B map U"
-    proof (induct T)
+    shows "A.con T U \<Longrightarrow> map T \<frown>\<^sub>B map U \<and> map (T \<^sup>*\\\<^sub>A\<^sup>* U) = map T \\\<^sub>B map U"
+    proof (induct T arbitrary: U)
       show "\<And>U. A.con [] U \<Longrightarrow> map [] \<frown>\<^sub>B map U \<and> map ([] \<^sup>*\\\<^sub>A\<^sup>* U) = map [] \\\<^sub>B map U"
         using A.con_char A.Resid.simps(1) by blast
       fix t T U
       assume tT: "A.con (t # T) U"
       assume ind: "\<And>U. A.con T U \<Longrightarrow>
                          map T \<frown>\<^sub>B map U \<and> map (T \<^sup>*\\\<^sub>A\<^sup>* U) = map T \\\<^sub>B map U"
       show "map (t # T) \<frown>\<^sub>B map U \<and> map ((t # T) \<^sup>*\\\<^sub>A\<^sup>* U) = map (t # T) \\\<^sub>B map U"
       proof (cases "T = []")
         assume T: "T = []"
         show ?thesis
           using T tT
           apply simp
           by (metis A.Resid1x_as_Resid A.Residx1_as_Resid A.con_char
               A.Con_sym A.Con_sym1 map.simps(2) preserves_Resid1x_ind)
         next
         assume T: "T \<noteq> []"
         have 1: "map (t # T) = F t \<cdot>\<^sub>B map T"
           using tT T
           by (metis A.con_implies_arr(1) list.exhaust map.simps(3))
         show ?thesis
         proof
           show 2: "B.con (map (t # T)) (map U)"
             using T tT
             by (metis "1" A.Con_cons(1) A.Residx1_as_Resid A.con_char A.not_arr_null
                 A.null_char B.composable_iff_comp_not_null B.con_compI(2) B.con_sym
                 B.not_arr_null preserves_arr ind preserves_Residx1_ind A.con_implies_arr(1-2))
           show "map ((t # T) \<^sup>*\\\<^sub>A\<^sup>* U) = map (t # T) \\\<^sub>B map U"
           proof -
             have "map ((t # T) \<^sup>*\\\<^sub>A\<^sup>* U) = map (([t] \<^sup>*\\\<^sub>A\<^sup>* U) @ (T \<^sup>*\\\<^sub>A\<^sup>* (U \<^sup>*\\\<^sub>A\<^sup>* [t])))"
               by (metis A.Resid.simps(1) A.Resid_cons(1) A.con_char A.ex_un_null tT)
             also have "... = map ([t] \<^sup>*\\\<^sub>A\<^sup>* U) \<cdot>\<^sub>B map (T \<^sup>*\\\<^sub>A\<^sup>* (U \<^sup>*\\\<^sub>A\<^sup>* [t]))"
               by (metis A.Arr.simps(1) A.Con_imp_Arr_Resid A.Con_implies_Arr(2) A.Con_sym
                   A.Resid_cons(1-2) A.con_char T preserves_comp tT)
             also have "... = (map [t] \\\<^sub>B map U) \<cdot>\<^sub>B map (T \<^sup>*\\\<^sub>A\<^sup>* (U \<^sup>*\\\<^sub>A\<^sup>* [t]))"
               by (metis A.Con_initial_right A.Con_sym A.Resid1x_as_Resid
                   A.Residx1_as_Resid A.con_char A.Con_sym1 map.simps(2)
                   preserves_Resid1x_ind tT)
             also have "... = (map [t] \\\<^sub>B map U) \<cdot>\<^sub>B (map T \\\<^sub>B map (U \<^sup>*\\\<^sub>A\<^sup>* [t]))"
               using tT T ind
               by (metis A.Con_cons(1) A.Con_sym A.Resid.simps(1) A.con_char)
             also have "... = (map [t] \\\<^sub>B map U) \<cdot>\<^sub>B (map T \\\<^sub>B (map U \\\<^sub>B map [t]))"
               using tT T
               by (metis A.Con_cons(1) A.Con_sym A.Resid.simps(2) A.Residx1_as_Resid
                         A.con_char map.simps(2) preserves_Residx1_ind)
             also have "... = (F t \\\<^sub>B map U) \<cdot>\<^sub>B (map T \\\<^sub>B (map U \\\<^sub>B F t))"
               using tT T by simp
             also have "... = map (t # T) \\\<^sub>B map U"
               using 1 2 B.resid_comp(2) by presburger
             finally show ?thesis by simp
           qed
         qed
       qed
     qed
 
     lemma preserves_con:
     assumes "A.con T U"
     shows "map T \<frown>\<^sub>B map U"
       using assms preserves_resid_ind by simp
 
     lemma preserves_resid:
     assumes "A.con T U"
     shows "map (T \<^sup>*\\\<^sub>A\<^sup>* U) = map T \\\<^sub>B map U"
       using assms preserves_resid_ind by simp
 
     sublocale simulation A.Resid resid\<^sub>B map
       using A.con_char preserves_con preserves_resid extensional
       by unfold_locales auto
 
     sublocale simulation_to_extensional_rts A.Resid resid\<^sub>B map ..
 
     lemma is_universal:
     assumes "rts_with_composites resid\<^sub>B" and "simulation resid\<^sub>A resid\<^sub>B F"
     shows "\<exists>!F'. simulation A.Resid resid\<^sub>B F' \<and> F' o A.incl = F"
     proof
       interpret B: rts_with_composites resid\<^sub>B
         using assms by auto
       interpret F: simulation resid\<^sub>A resid\<^sub>B F
         using assms by auto
       show "simulation A.Resid resid\<^sub>B map \<and> map \<circ> A.incl = F"
         using map_o_incl_eq simulation_axioms by auto
       show "\<And>F'. simulation A.Resid resid\<^sub>B F' \<and> F' o A.incl = F \<Longrightarrow> F' = map"
       proof
         fix F' T
         assume F': "simulation A.Resid resid\<^sub>B F' \<and> F' o A.incl = F"
         interpret F': simulation A.Resid resid\<^sub>B F'
           using F' by simp
         show "F' T = map T"
         proof (induct T)
           show "F' [] = map []"
             by (simp add: A.arr_char F'.extensional)
           fix t T
           assume ind: "F' T = map T"
           show "F' (t # T) = map (t # T)"
           proof (cases "A.Arr (t # T)")
             show "\<not> A.Arr (t # T) \<Longrightarrow> ?thesis"
               by (simp add: A.arr_char F'.extensional extensional)
             assume tT: "A.Arr (t # T)"
             show ?thesis
             proof (cases "T = []")
               show 2: "T = [] \<Longrightarrow> ?thesis"
                 using F' tT by auto
               assume T: "T \<noteq> []"
               have "F' (t # T) = F' [t] \<cdot>\<^sub>B map T"
               proof -
                 have "F' (t # T) = F' ([t] @ T)"
                   by simp
                 also have "... = F' [t] \<cdot>\<^sub>B F' T"
                 proof -
                   have "A.composite_of [t] T ([t] @ T)"
                     using T tT
                     by (metis (full_types) A.Arr.simps(2) A.Con_Arr_self
                         A.append_is_composite_of A.Con_implies_Arr(1) A.Con_imp_eq_Srcs
                         A.Con_rec(4) A.Resid_rec(1) A.Srcs_Resid A.seq_char A.R.arrI)
                   thus ?thesis
                     using F'.preserves_composites [of "[t]" T "[t] @ T"] B.comp_is_composite_of
                     by auto
                 qed
                 also have "... = F' [t] \<cdot>\<^sub>B map T"
                   using T ind by simp
                 finally show ?thesis by simp
               qed
               also have "... = (F' \<circ> A.incl) t \<cdot>\<^sub>B map T"
                 using tT
                 by (simp add: A.arr_char A.null_char F'.extensional)
               also have "... = F t \<cdot>\<^sub>B map T"
                 using F' by simp
               also have "... = map (t # T)"
                 using T tT
                 by (metis A.arr_char list.exhaust map.simps(3))
               finally show ?thesis by simp
             qed
           qed
         qed
       qed
     qed
 
   end
 
   (*
    * TODO: Localize to context rts?
    *)
   lemma composite_completion_of_rts:
   assumes "rts A"
   shows "\<exists>(C :: 'a list resid) I. rts_with_composites C \<and> simulation A C I \<and>
           (\<forall>B (J :: 'a \<Rightarrow> 'c). extensional_rts_with_composites B \<and> simulation A B J
                                  \<longrightarrow> (\<exists>!J'. simulation C B J' \<and> J' o I = J))"
   proof (intro exI conjI)
     interpret A: rts A
       using assms by auto
     interpret P\<^sub>A: paths_in_rts A ..
     show "rts_with_composites P\<^sub>A.Resid"
       using P\<^sub>A.rts_with_composites_axioms by simp
     show "simulation A P\<^sub>A.Resid P\<^sub>A.incl"
       using P\<^sub>A.incl_is_simulation by simp
     show "\<forall>B (J :: 'a \<Rightarrow> 'c). extensional_rts_with_composites B \<and> simulation A B J
                                 \<longrightarrow> (\<exists>!J'. simulation P\<^sub>A.Resid B J' \<and> J' o P\<^sub>A.incl = J)"
     proof (intro allI impI)
       fix B :: "'c resid" and J
       assume 1: "extensional_rts_with_composites B \<and> simulation A B J"
       interpret B: extensional_rts_with_composites B
         using 1 by simp
       interpret J: simulation A B J
         using 1 by simp
       interpret J: extension_of_simulation A B J
         ..
       have "simulation P\<^sub>A.Resid B J.map"
         using J.simulation_axioms by simp
       moreover have "J.map o P\<^sub>A.incl = J"
         using J.map_o_incl_eq by auto
       moreover have "\<And>J'. simulation P\<^sub>A.Resid B J' \<and> J' o P\<^sub>A.incl = J \<Longrightarrow> J' = J.map"
         using "1" B.rts_with_composites_axioms J.is_universal J.simulation_axioms
               calculation(2)
         by blast
       ultimately show "\<exists>!J'. simulation P\<^sub>A.Resid B J' \<and> J' \<circ> P\<^sub>A.incl = J" by auto
     qed
   qed
 
   section "Constructions on RTS's"
 
   subsection "Products of RTS's"
 
   locale product_rts =
     R1: rts R1 +
     R2: rts R2
   for R1 :: "'a1 resid"      (infix "\\\<^sub>1" 70)
   and R2 :: "'a2 resid"      (infix "\\\<^sub>2" 70)
   begin
 
     type_synonym ('aa1, 'aa2) arr = "'aa1 * 'aa2"
 
     abbreviation (input) Null :: "('a1, 'a2) arr"
     where "Null \<equiv> (R1.null, R2.null)"
 
     definition resid :: "('a1, 'a2) arr \<Rightarrow> ('a1, 'a2) arr \<Rightarrow> ('a1, 'a2) arr"
     where "resid t u = (if R1.con (fst t) (fst u) \<and> R2.con (snd t) (snd u)
                         then (fst t \\\<^sub>1 fst u, snd t \\\<^sub>2 snd u)
                         else Null)"
 
     notation resid      (infix "\\" 70)
 
     sublocale partial_magma resid
       by unfold_locales
         (metis R1.con_implies_arr(1-2) R1.not_arr_null fst_conv resid_def)
 
     lemma is_partial_magma:
     shows "partial_magma resid"
       ..
 
     lemma null_char [simp]:
     shows "null = Null"
       by (metis R2.null_is_zero(1) R2.residuation_axioms ex_un_null null_is_zero(1)
           resid_def residuation.conE snd_conv)
 
     sublocale residuation resid
     proof
       show "\<And>t u. t \\ u \<noteq> null \<Longrightarrow> u \\ t \<noteq> null"
         by (metis R1.con_def R1.con_sym null_char prod.inject resid_def R2.con_sym)
       show "\<And>t u. t \\ u \<noteq> null \<Longrightarrow> (t \\ u) \\ (t \\ u) \<noteq> null"
         by (metis (no_types, lifting) R1.arrE R2.con_def R2.con_imp_arr_resid fst_conv null_char
             resid_def R1.arr_resid snd_conv)
       show "\<And>v t u. (v \\ t) \\ (u \\ t) \<noteq> null \<Longrightarrow> (v \\ t) \\ (u \\ t) = (v \\ u) \\ (t \\ u)"
       proof -
         fix t u v
         assume 1: "(v \\ t) \\ (u \\ t) \<noteq> null"
         have "(fst v \\\<^sub>1 fst t) \\\<^sub>1 (fst u \\\<^sub>1 fst t) \<noteq> R1.null"
           by (metis 1 R1.not_arr_null fst_conv null_char null_is_zero(1-2)
               resid_def R1.arr_resid)
         moreover have "(snd v \\\<^sub>2 snd t) \\\<^sub>2 (snd u \\\<^sub>2 snd t) \<noteq> R2.null"
           by (metis 1 R2.not_arr_null snd_conv null_char null_is_zero(1-2)
               resid_def R2.arr_resid)
         ultimately show "(v \\ t) \\ (u \\ t) = (v \\ u) \\ (t \\ u)"
           using resid_def null_char R1.con_def R2.con_def R1.cube R2.cube
           apply simp
           by (metis (no_types, lifting) R1.conI R1.con_sym_ax R1.resid_reflects_con
               R2.con_sym_ax R2.null_is_zero(1))
       qed
     qed
 
     lemma is_residuation:
     shows "residuation resid"
       ..
 
     lemma arr_char [iff]:
     shows "arr t \<longleftrightarrow> R1.arr (fst t) \<and> R2.arr (snd t)"
       by (metis (no_types, lifting) R1.arr_def R2.arr_def R2.conE null_char resid_def
           residuation.arr_def residuation.con_def residuation_axioms snd_eqD)
 
     lemma ide_char [iff]:
     shows "ide t \<longleftrightarrow> R1.ide (fst t) \<and> R2.ide (snd t)"
       by (metis (no_types, lifting) R1.residuation_axioms R2.residuation_axioms
           arr_char arr_def fst_conv null_char prod.collapse resid_def residuation.conE
           residuation.ide_def residuation.ide_implies_arr residuation_axioms snd_conv)
 
     lemma con_char [iff]:
     shows "con t u \<longleftrightarrow> R1.con (fst t) (fst u) \<and> R2.con (snd t) (snd u)"
       by (simp add: R2.residuation_axioms con_def resid_def residuation.con_def)
 
     lemma trg_char:
     shows "trg t = (if arr t then (R1.trg (fst t), R2.trg (snd t)) else Null)"
       using R1.trg_def R2.trg_def resid_def trg_def by auto
 
     sublocale rts resid
     proof
       show "\<And>t. arr t \<Longrightarrow> ide (trg t)"
         by (simp add: trg_char)
       show "\<And>a t. \<lbrakk>ide a; con t a\<rbrakk> \<Longrightarrow> t \\ a = t"
         by (simp add: R1.resid_arr_ide R2.resid_arr_ide resid_def)
       show "\<And>a t. \<lbrakk>ide a; con a t\<rbrakk> \<Longrightarrow> ide (a \\ t)"
         by (metis \<open>\<And>t a. \<lbrakk>ide a; con t a\<rbrakk> \<Longrightarrow> t \ a = t\<close> con_sym cube ideE ideI
             residuation.con_def residuation_axioms)
       show "\<And>t u. con t u \<Longrightarrow> \<exists>a. ide a \<and> con a t \<and> con a u"
       proof -
         fix t u
         assume tu: "con t u"
         obtain a1 where a1: "a1 \<in> R1.sources (fst t) \<inter> R1.sources (fst u)"
           by (meson R1.con_imp_common_source all_not_in_conv con_char tu)
         obtain a2 where a2: "a2 \<in> R2.sources (snd t) \<inter> R2.sources (snd u)"
           by (meson R2.con_imp_common_source all_not_in_conv con_char tu)
         have "ide (a1, a2) \<and> con (a1, a2) t \<and> con (a1, a2) u"
           using a1 a2 ide_char con_char
           by (metis R1.con_imp_common_source R1.in_sourcesE R1.sources_eqI
               R2.con_imp_common_source R2.in_sourcesE R2.sources_eqI con_sym
               fst_conv inf_idem snd_conv tu)
         thus "\<exists>a. ide a \<and> con a t \<and> con a u" by blast
       qed
       show "\<And>t u v. \<lbrakk>ide (t \\ u); con u v\<rbrakk> \<Longrightarrow> con (t \\ u) (v \\ u)"
       proof -
         fix t u v
         assume tu: "ide (t \\ u)"
         assume uv: "con u v"
         have "R1.ide (fst t \\\<^sub>1 fst u) \<and> R2.ide (snd t \\\<^sub>2 snd u)"
           using tu ide_char
           by (metis conI con_char fst_eqD ide_implies_arr not_arr_null resid_def snd_conv)
         moreover have "R1.con (fst u) (fst v) \<and> R2.con (snd u) (snd v)"
           using uv con_char by blast
         ultimately show "con (t \\ u) (v \\ u)"
           by (simp add: R1.con_target R1.con_sym R1.prfx_implies_con
               R2.con_target R2.con_sym R2.prfx_implies_con resid_def)
       qed
     qed
 
     lemma is_rts:
     shows "rts resid"
       ..
 
     lemma sources_char:
     shows "sources t = R1.sources (fst t) \<times> R2.sources (snd t)"
       by force
 
     lemma targets_char:
     shows "targets t = R1.targets (fst t) \<times> R2.targets (snd t)"
     proof
       show "targets t \<subseteq> R1.targets (fst t) \<times> R2.targets (snd t)"
         using targets_def ide_char con_char resid_def trg_char trg_def by auto
       show "R1.targets (fst t) \<times> R2.targets (snd t) \<subseteq> targets t"
       proof
         fix a
         assume a: "a \<in> R1.targets (fst t) \<times> R2.targets (snd t)"
         show "a \<in> targets t"
         proof
           show "ide a"
             using a ide_char by auto
           show "con (trg t) a"
             using a trg_char con_char [of "trg t" a]
             by (metis (no_types, lifting) SigmaE arr_char con_char con_implies_arr(1)
                 fst_conv R1.in_targetsE R2.in_targetsE R1.arr_resid_iff_con R2.arr_resid_iff_con
                 R1.trg_def R2.trg_def snd_conv)
         qed
       qed
     qed
 
     lemma prfx_char:
     shows "prfx t u \<longleftrightarrow> R1.prfx (fst t) (fst u) \<and> R2.prfx (snd t) (snd u)"
       using R1.prfx_implies_con R2.prfx_implies_con resid_def by auto
 
     lemma cong_char:
     shows "cong t u \<longleftrightarrow> R1.cong (fst t) (fst u) \<and> R2.cong (snd t) (snd u)"
       using prfx_char by auto
 
   end
 
   locale product_of_weakly_extensional_rts =
     R1: weakly_extensional_rts R1 +
     R2: weakly_extensional_rts R2 +
     product_rts
   begin
 
     sublocale weakly_extensional_rts resid
     proof
       show "\<And>t u. \<lbrakk>cong t u; ide t; ide u\<rbrakk> \<Longrightarrow> t = u"
         by (metis cong_char ide_char prod.exhaust_sel R1.weak_extensionality R2.weak_extensionality)
     qed
 
     lemma src_char:
     shows "src t = (if arr t then (R1.src (fst t), R2.src (snd t)) else null)"
     proof (cases "arr t")
       show "\<not> arr t \<Longrightarrow> ?thesis"
         using src_def by presburger
       assume t: "arr t"
       show ?thesis
       proof (intro src_eqI)
         show "ide (if arr t then (R1.src (fst t), R2.src (snd t)) else null)"
           using t by simp
         show "con (if arr t then (R1.src (fst t), R2.src (snd t)) else null) t"
           using t con_char arr_char
           apply (cases t)
           apply simp_all
           by (metis R1.con_imp_coinitial_ax R1.residuation_axioms R1.src_eqI R2.con_sym
               R2.in_sourcesE R2.src_in_sources residuation.arr_def)
       qed
     qed
 
   end
 
   locale product_of_extensional_rts =
     R1: extensional_rts R1 +
     R2: extensional_rts R2 +
     product_of_weakly_extensional_rts
   begin
 
     sublocale extensional_rts resid
     proof
       show "\<And>t u. cong t u \<Longrightarrow> t = u"
         by (metis R1.extensional R2.extensional cong_char prod.collapse)
     qed
 
   end
 
   subsubsection "Product Simulations"
 
   locale product_simulation =
     A1: rts A1 +
     A2: rts A2 +
     B1: rts B1 +
     B2: rts B2 +
     A1xA2: product_rts A1 A2 +
     B1xB2: product_rts B1 B2 +
     F1: simulation A1 B1 F1 +
     F2: simulation A2 B2 F2
   for A1 :: "'a1 resid"      (infix "\\\<^sub>A\<^sub>1" 70)
   and A2 :: "'a2 resid"      (infix "\\\<^sub>A\<^sub>2" 70)
   and B1 :: "'b1 resid"      (infix "\\\<^sub>B\<^sub>1" 70)
   and B2 :: "'b2 resid"      (infix "\\\<^sub>B\<^sub>2" 70)
   and F1 :: "'a1 \<Rightarrow> 'b1"
   and F2 :: "'a2 \<Rightarrow> 'b2"
   begin
 
     definition map
     where "map = (\<lambda>a. if A1xA2.arr a then (F1 (fst a), F2 (snd a)) else B1xB2.null)"
 
     lemma map_simp [simp]:
     assumes "A1.arr a1" and "A2.arr a2"
     shows "map (a1, a2) = (F1 a1, F2 a2)"
       using assms map_def by auto
 
     sublocale simulation A1xA2.resid B1xB2.resid map
     proof
       show "\<And>t. \<not> A1xA2.arr t \<Longrightarrow> map t = B1xB2.null"
         using map_def by auto
       show "\<And>t u. A1xA2.con t u \<Longrightarrow> B1xB2.con (map t) (map u)"
         using A1xA2.con_char B1xB2.con_char A1.con_implies_arr A2.con_implies_arr by auto
       show "\<And>t u. A1xA2.con t u \<Longrightarrow> map (A1xA2.resid t u) = B1xB2.resid (map t) (map u)"
         using A1xA2.resid_def B1xB2.resid_def A1.con_implies_arr A2.con_implies_arr
         by auto
     qed
 
     lemma is_simulation:
     shows "simulation A1xA2.resid B1xB2.resid map"
       ..
 
   end
 
   subsubsection "Binary Simulations"
 
   locale binary_simulation =
     A1: rts A1 +
     A2: rts A2 +
     A: product_rts A1 A2 +
     B: rts B +
     simulation A.resid B F
   for A1 :: "'a1 resid"    (infixr "\\\<^sub>A\<^sub>1" 70)
   and A2 :: "'a2 resid"    (infixr "\\\<^sub>A\<^sub>2" 70)
   and B :: "'b resid"      (infixr "\\\<^sub>B" 70)
   and F :: "'a1 * 'a2 \<Rightarrow> 'b"
   begin
 
     lemma fixing_ide_gives_simulation_1:
     assumes "A1.ide a1"
     shows "simulation A2 B (\<lambda>t2. F (a1, t2))"
     proof
       show "\<And>t2. \<not> A2.arr t2 \<Longrightarrow> F (a1, t2) = B.null"
         using assms extensional A.arr_char by simp
       show "\<And>t2 u2. A2.con t2 u2 \<Longrightarrow> B.con (F (a1, t2)) (F (a1, u2))"
         using assms A.con_char preserves_con by auto
       show "\<And>t2 u2. A2.con t2 u2 \<Longrightarrow> F (a1, t2 \\\<^sub>A\<^sub>2 u2) = F (a1, t2) \\\<^sub>B F (a1, u2)"
         using assms A.con_char A.resid_def preserves_resid
         by (metis A1.ideE fst_conv snd_conv)
     qed
 
     lemma fixing_ide_gives_simulation_2:
     assumes "A2.ide a2"
     shows "simulation A1 B (\<lambda>t1. F (t1, a2))"
     proof
       show "\<And>t1. \<not> A1.arr t1 \<Longrightarrow> F (t1, a2) = B.null"
         using assms extensional A.arr_char by simp
       show "\<And>t1 u1. A1.con t1 u1 \<Longrightarrow> B.con (F (t1, a2)) (F (u1, a2))"
         using assms A.con_char preserves_con by auto
       show "\<And>t1 u1. A1.con t1 u1 \<Longrightarrow> F (t1 \\\<^sub>A\<^sub>1 u1, a2) = F (t1, a2) \\\<^sub>B F (u1, a2)"
         using assms A.con_char A.resid_def preserves_resid
         by (metis A2.ideE fst_conv snd_conv)
     qed
 
   end
 
   subsection "Sub-RTS's"
 
   locale sub_rts =
     R: rts R
   for R :: "'a resid"      (infix "\\\<^sub>R" 70)
   and Arr :: "'a \<Rightarrow> bool" +
   assumes inclusion: "Arr t \<Longrightarrow> R.arr t"
   and sources_closed: "Arr t \<Longrightarrow> R.sources t \<subseteq> Collect Arr"
   and resid_closed: "\<lbrakk>Arr t; Arr u; R.con t u\<rbrakk> \<Longrightarrow> Arr (t \\\<^sub>R u)"
   begin
 
     definition resid  (infix "\\" 70)
     where "t \\ u \<equiv> (if Arr t \<and> Arr u \<and> R.con t u then t \\\<^sub>R u else R.null)"
 
     sublocale partial_magma resid
       by unfold_locales
         (metis R.ex_un_null R.null_is_zero(2) resid_def)
 
     lemma is_partial_magma:
     shows "partial_magma resid"
       ..
 
     lemma null_char [simp]:
     shows "null = R.null"
       by (metis R.null_is_zero(1) ex_un_null null_is_zero(1) resid_def)
 
     sublocale residuation resid
     proof
       show "\<And>t u. t \\ u \<noteq> null \<Longrightarrow> u \\ t \<noteq> null"
         by (metis R.con_sym R.con_sym_ax null_char resid_def)
       show "\<And>t u. t \\ u \<noteq> null \<Longrightarrow> (t \\ u) \\ (t \\ u) \<noteq> null"
         by (metis R.arrE R.arr_resid R.not_arr_null null_char resid_closed resid_def)
       show "\<And>v t u. (v \\ t) \\ (u \\ t) \<noteq> null \<Longrightarrow> (v \\ t) \\ (u \\ t) = (v \\ u) \\ (t \\ u)"
         by (metis R.cube R.ex_un_null R.null_is_zero(1) R.residuation_axioms null_is_zero(2)
             resid_closed resid_def residuation.conE residuation.conI)
     qed
 
     lemma is_residuation:
     shows "residuation resid"
       ..
 
     lemma arr_char [iff]:
     shows "arr t \<longleftrightarrow> Arr t"
     proof
       show "arr t \<Longrightarrow> Arr t"
         by (metis arrE conE null_char resid_def)
       show "Arr t \<Longrightarrow> arr t"
         by (metis R.arrE R.conE conI con_implies_arr(2) inclusion null_char resid_def)
     qed
 
     lemma ide_char [iff]:
     shows "ide t \<longleftrightarrow> Arr t \<and> R.ide t"
       by (metis R.ide_def arrE arr_char conE ide_def null_char resid_def)
 
     lemma con_char [iff]:
     shows "con t u \<longleftrightarrow> Arr t \<and> Arr u \<and> R.con t u"
       using con_def resid_def by auto
 
     lemma trg_char:
     shows "trg t = (if arr t then R.trg t else null)"
       using R.trg_def arr_def resid_def trg_def by force
 
     sublocale rts resid
     proof
       show "\<And>t. arr t \<Longrightarrow> ide (trg t)"
         by (metis R.ide_trg arrE arr_char arr_resid ide_char inclusion trg_char trg_def)
       show "\<And>a t. \<lbrakk>ide a; con t a\<rbrakk> \<Longrightarrow> t \\ a = t"
         by (simp add: R.resid_arr_ide resid_def)
       show "\<And>a t. \<lbrakk>ide a; con a t\<rbrakk> \<Longrightarrow> ide (a \\ t)"
         by (metis R.resid_ide_arr arr_resid_iff_con arr_char con_char ide_char resid_def)
       show "\<And>t u. con t u \<Longrightarrow> \<exists>a. ide a \<and> con a t \<and> con a u"
         by (metis (full_types) R.con_imp_coinitial_ax R.con_sym R.in_sourcesI
             con_char ide_char in_mono mem_Collect_eq sources_closed)
       show "\<And>t u v. \<lbrakk>ide (t \\ u); con u v\<rbrakk> \<Longrightarrow> con (t \\ u) (v \\ u)"
         by (metis R.con_target arr_resid_iff_con con_char con_sym ide_char
             ide_implies_arr resid_closed resid_def)
     qed
 
     lemma is_rts:
     shows "rts resid"
       ..
 
     lemma sources_char\<^sub>S\<^sub>R\<^sub>T\<^sub>S:
     shows "sources t = {a. Arr t \<and> a \<in> R.sources t}"
       using sources_closed by auto
 
     lemma targets_char\<^sub>S\<^sub>R\<^sub>T\<^sub>S:
     shows "targets t = {b. Arr t \<and> b \<in> R.targets t}"
     proof
       show "targets t \<subseteq> {b. Arr t \<and> b \<in> R.targets t}"
       proof
         fix b
         assume b: "b \<in> targets t"
         show "b \<in> {b. Arr t \<and> b \<in> R.targets t}"
         proof
           have "Arr t"
             using arr_iff_has_target b by force
           moreover have "Arr b"
             using b by blast
           moreover have "b \<in> R.targets t"
             by (metis R.in_targetsI b calculation(1) con_char in_targetsE
                 arr_char ide_char trg_char)
           ultimately show "Arr t \<and> b \<in> R.targets t" by blast
         qed
       qed
       show "{b. Arr t \<and> b \<in> R.targets t} \<subseteq> targets t"
       proof
         fix b
         assume b: "b \<in> {b. Arr t \<and> b \<in> R.targets t}"
         show "b \<in> targets t"
         proof (intro in_targetsI)
           show "ide b"
             using b
             by (metis R.arrE ide_char inclusion mem_Collect_eq R.sources_resid
                 R.target_is_ide resid_closed sources_closed subset_eq)
           show "con (trg t) b"
             using b
             using \<open>ide b\<close> ide_trg trg_char by auto
         qed
       qed
     qed
 
     lemma prfx_char\<^sub>S\<^sub>R\<^sub>T\<^sub>S:
     shows "prfx t u \<longleftrightarrow> Arr t \<and> Arr u \<and> R.prfx t u"
       by (metis R.prfx_implies_con con_char ide_char prfx_implies_con resid_closed resid_def)
 
     lemma cong_char\<^sub>S\<^sub>R\<^sub>T\<^sub>S:
     shows "cong t u \<longleftrightarrow> Arr t \<and> Arr u \<and> R.cong t u"
       using prfx_char\<^sub>S\<^sub>R\<^sub>T\<^sub>S by force
 
     lemma inclusion_is_simulation:
     shows "simulation resid R (\<lambda>t. if arr t then t else null)"
       using resid_closed resid_def
       by unfold_locales auto
 
     interpretation P\<^sub>R: paths_in_rts R
       ..
     interpretation P: paths_in_rts resid
       ..
 
     lemma path_reflection:
     shows "\<lbrakk>P\<^sub>R.Arr T; set T \<subseteq> Collect Arr\<rbrakk> \<Longrightarrow> P.Arr T"
       apply (induct T)
        apply simp
     proof -
       fix t T
       assume ind: "\<lbrakk>P\<^sub>R.Arr T; set T \<subseteq> Collect Arr\<rbrakk> \<Longrightarrow> P.Arr T"
       assume tT: "P\<^sub>R.Arr (t # T)"
       assume set: "set (t # T) \<subseteq> Collect Arr"
       have 1: "R.arr t"
         using tT
         by (metis P\<^sub>R.Arr_imp_arr_hd list.sel(1))
       show "P.Arr (t # T)"
       proof (cases "T = []")
         show "T = [] \<Longrightarrow> ?thesis"
           using 1 set by simp
         assume T: "T \<noteq> []"
         show ?thesis
         proof
           show "arr t"
             using 1 arr_char set by simp
           show "P.Arr T"
             using T tT P\<^sub>R.Arr_imp_Arr_tl
             by (metis ind insert_subset list.sel(3) list.simps(15) set)
           show "targets t \<subseteq> P.Srcs T"
           proof -
             have "targets t \<subseteq> R.targets t"
               using targets_char\<^sub>S\<^sub>R\<^sub>T\<^sub>S by blast
             also have "... \<subseteq> R.sources (hd T)"
               using T tT
               by (metis P\<^sub>R.Arr.simps(3) P\<^sub>R.Srcs_simp\<^sub>P list.collapse)
             also have "... \<subseteq> P.Srcs T"
               using P.Arr_imp_arr_hd P.Srcs_simp\<^sub>P \<open>P.Arr T\<close> sources_char\<^sub>S\<^sub>R\<^sub>T\<^sub>S by force
             finally show ?thesis by blast
           qed
         qed
       qed
     qed
 
   end
 
   locale sub_weakly_extensional_rts =
     sub_rts +
     R: weakly_extensional_rts R
   begin
 
     sublocale weakly_extensional_rts resid
       apply unfold_locales
       using R.weak_extensionality cong_char\<^sub>S\<^sub>R\<^sub>T\<^sub>S
       by blast
 
     lemma is_weakly_extensional_rts:
     shows "weakly_extensional_rts resid"
       ..
 
     lemma src_char:
     shows "src t = (if arr t then R.src t else null)"
     proof (cases "arr t")
       show "\<not> arr t \<Longrightarrow> ?thesis"
         by (simp add: src_def)
       assume t: "arr t"
       show ?thesis
       proof (intro src_eqI)
         show "ide (if arr t then R.src t else null)"
           using t sources_closed inclusion R.src_in_sources by auto
         show "con (if arr t then R.src t else null) t"
           using t con_char
           by (metis (full_types) R.con_sym R.in_sourcesE R.src_in_sources
               \<open>ide (if arr t then R.src t else null)\<close> arr_char ide_char inclusion)
       qed
     qed
 
   end
 
   text \<open>
     Here we justify the terminology ``normal sub-RTS'', which was introduced earlier,
     by showing that a normal sub-RTS really is a sub-RTS.
   \<close>
 
   lemma (in normal_sub_rts) is_sub_rts:
   shows "sub_rts resid (\<lambda>t. t \<in> \<NN>)"
     using elements_are_arr ide_closed
     apply unfold_locales
       apply auto[2]
     by (meson R.con_imp_coinitial R.con_sym forward_stable)
 
 end