diff --git a/thys/Stateful_Protocol_Composition_and_Typing/Stateful_Compositionality.thy b/thys/Stateful_Protocol_Composition_and_Typing/Stateful_Compositionality.thy
--- a/thys/Stateful_Protocol_Composition_and_Typing/Stateful_Compositionality.thy
+++ b/thys/Stateful_Protocol_Composition_and_Typing/Stateful_Compositionality.thy
@@ -1,3086 +1,3086 @@
 (*
 (C) Copyright Andreas Viktor Hess, DTU, 2018-2020
 
 All Rights Reserved.
 
 Redistribution and use in source and binary forms, with or without
 modification, are permitted provided that the following conditions are
 met:
 
 - Redistributions of source code must retain the above copyright
   notice, this list of conditions and the following disclaimer.
 
 - Redistributions in binary form must reproduce the above copyright
   notice, this list of conditions and the following disclaimer in the
   documentation and/or other materials provided with the distribution.
 
 - Neither the name of the copyright holder nor the names of its
   contributors may be used to endorse or promote products
   derived from this software without specific prior written
   permission.
 
 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
 A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
 OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
 SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
 LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
 DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
 THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
 (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
 OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 *)
 
 (*  Title:      Stateful_Compositionality.thy
     Author:     Andreas Viktor Hess, DTU
 *)
 
 
 section \<open>Stateful Protocol Compositionality\<close>
 
 theory Stateful_Compositionality
 imports Stateful_Typing Parallel_Compositionality Labeled_Stateful_Strands
 begin
 
 subsection \<open>Small Lemmata\<close>
 lemma (in typed_model) wt_subst_sstp_vars_type_subset:
   fixes a::"('fun,'var) stateful_strand_step"
   assumes "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>"
     and "\<forall>t \<in> subst_range \<delta>. fv t = {} \<or> (\<exists>x. t = Var x)"
   shows "\<Gamma> ` Var ` fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>) \<subseteq> \<Gamma> ` Var ` fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p a" (is ?A)
     and "\<Gamma> ` Var ` set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>)) = \<Gamma> ` Var ` set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p a)" (is ?B)
     and "\<Gamma> ` Var ` vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>) \<subseteq> \<Gamma> ` Var ` vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p a" (is ?C)
 proof -
   show ?A
   proof
     fix \<tau> assume \<tau>: "\<tau> \<in> \<Gamma> ` Var ` fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>)"
     then obtain x where x: "x \<in> fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>)" "\<Gamma> (Var x) = \<tau>" by moura
-  
+
     show "\<tau> \<in> \<Gamma> ` Var ` fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p a"
     proof (cases "x \<in> fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p a")
       case False
       hence "\<exists>y \<in> fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p a. \<delta> y = Var x"
       proof (cases a)
         case (NegChecks X F G)
         hence *: "x \<in> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \<delta>) \<union> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (G \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \<delta>)"
                  "x \<notin> set X"
           using fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p_NegCheck(1)[of X "F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \<delta>" "G \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \<delta>"]
                 fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p_NegCheck(1)[of X F G] False x(1)
           by fastforce+
-  
+
         obtain y where y: "y \<in> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \<union> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s G" "x \<in> fv (rm_vars (set X) \<delta> y)"
           using fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_subst_obtain_var[of _ _ "rm_vars (set X) \<delta>"]
                 fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_subst_obtain_var[of _ _ "rm_vars (set X) \<delta>"]
                 *(1)
           by blast
-  
+
         have "fv (rm_vars (set X) \<delta> z) = {} \<or> (\<exists>u. rm_vars (set X) \<delta> z = Var u)" for z
           using assms(2) rm_vars_img_subset[of "set X" \<delta>] by blast
         hence "rm_vars (set X) \<delta> y = Var x" using y(2) by fastforce
         hence "\<exists>y \<in> fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p a. rm_vars (set X) \<delta> y = Var x"
           using y fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p_NegCheck(1)[of X F G] NegChecks *(2) by fastforce
         thus ?thesis by (metis (full_types) *(2) term.inject(1))
       qed (use assms(2) x(1) subst_apply_img_var'[of x _ \<delta>] in fastforce)+
       then obtain y where y: "y \<in> fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p a" "\<delta> y = Var x" by moura
       hence "\<Gamma> (Var y) = \<tau>" using x(2) assms(1) by (simp add: wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def)
       thus ?thesis using y(1) by auto
     qed (use x in auto)
   qed
 
   show ?B by (metis bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p_subst)
 
   show ?C
   proof
     fix \<tau> assume \<tau>: "\<tau> \<in> \<Gamma> ` Var ` vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>)"
     then obtain x where x: "x \<in> vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>)" "\<Gamma> (Var x) = \<tau>" by moura
-  
+
     show "\<tau> \<in> \<Gamma> ` Var ` vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p a"
     proof (cases "x \<in> vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p a")
       case False
       hence "\<exists>y \<in> vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p a. \<delta> y = Var x"
       proof (cases a)
         case (NegChecks X F G)
         hence *: "x \<in> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \<delta>) \<union> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (G \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \<delta>)"
                  "x \<notin> set X"
           using vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p_NegCheck[of X "F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \<delta>" "G \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \<delta>"]
                 vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p_NegCheck[of X F G] False x(1)
           by (fastforce, blast)
-  
+
         obtain y where y: "y \<in> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \<union> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s G" "x \<in> fv (rm_vars (set X) \<delta> y)"
           using fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_subst_obtain_var[of _ _ "rm_vars (set X) \<delta>"]
                 fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_subst_obtain_var[of _ _ "rm_vars (set X) \<delta>"]
                 *(1)
           by blast
-  
+
         have "fv (rm_vars (set X) \<delta> z) = {} \<or> (\<exists>u. rm_vars (set X) \<delta> z = Var u)" for z
           using assms(2) rm_vars_img_subset[of "set X" \<delta>] by blast
         hence "rm_vars (set X) \<delta> y = Var x" using y(2) by fastforce
         hence "\<exists>y \<in> vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p a. rm_vars (set X) \<delta> y = Var x"
           using y vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p_NegCheck[of X F G] NegChecks by blast
         thus ?thesis by (metis (full_types) *(2) term.inject(1))
       qed (use assms(2) x(1) subst_apply_img_var'[of x _ \<delta>] in fastforce)+
       then obtain y where y: "y \<in> vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p a" "\<delta> y = Var x" by moura
       hence "\<Gamma> (Var y) = \<tau>" using x(2) assms(1) by (simp add: wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def)
       thus ?thesis using y(1) by auto
     qed (use x in auto)
   qed
 qed
 
 lemma (in typed_model) wt_subst_lsst_vars_type_subset:
   fixes A::"('fun,'var,'a) labeled_stateful_strand"
   assumes "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>"
     and "\<forall>t \<in> subst_range \<delta>. fv t = {} \<or> (\<exists>x. t = Var x)"
   shows "\<Gamma> ` Var ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>) \<subseteq> \<Gamma> ` Var ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" (is ?A)
     and "\<Gamma> ` Var ` bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>) = \<Gamma> ` Var ` bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" (is ?B)
     and "\<Gamma> ` Var ` vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>) \<subseteq> \<Gamma> ` Var ` vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" (is ?C)
 proof -
   have "vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (a#A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>) = vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (b \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>) \<union> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>)"
        "vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (a#A) = vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p b \<union> vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"
        "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (a#A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>) = fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p (b \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>) \<union> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>)"
        "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (a#A) = fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p b \<union> fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"
        "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (a#A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>) = set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (b \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>)) \<union> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>)"
        "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (a#A) = set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p b) \<union> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"
     when "a = (l,b)" for a l b and A::"('fun,'var,'a) labeled_stateful_strand"
     using that unlabel_Cons(1)[of l b A] unlabel_subst[of "a#A" \<delta>]
           subst_lsst_cons[of a A \<delta>] subst_sst_cons[of b "unlabel A" \<delta>]
           subst_apply_labeled_stateful_strand_step.simps(1)[of l b \<delta>]
           vars\<^sub>s\<^sub>s\<^sub>t_unlabel_Cons[of l b A] vars\<^sub>s\<^sub>s\<^sub>t_unlabel_Cons[of l "b \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>" "A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>"]
           fv\<^sub>s\<^sub>s\<^sub>t_unlabel_Cons[of l b A] fv\<^sub>s\<^sub>s\<^sub>t_unlabel_Cons[of l "b \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>" "A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>"]
           bvars\<^sub>s\<^sub>s\<^sub>t_unlabel_Cons[of l b A] bvars\<^sub>s\<^sub>s\<^sub>t_unlabel_Cons[of l "b \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>" "A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>"]
     by simp_all
   hence *: "\<Gamma> ` Var ` vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (a#A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>) =
             \<Gamma> ` Var ` vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (b \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>) \<union> \<Gamma> ` Var ` vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>)"
            "\<Gamma> ` Var ` vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (a#A) = \<Gamma> ` Var ` vars\<^sub>s\<^sub>s\<^sub>t\<^sub>p b \<union> \<Gamma> ` Var ` vars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"
            "\<Gamma> ` Var ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (a#A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>) =
             \<Gamma> ` Var ` fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p (b \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>) \<union> \<Gamma> ` Var ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>)"
            "\<Gamma> ` Var ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t (a#A) = \<Gamma> ` Var ` fv\<^sub>s\<^sub>s\<^sub>t\<^sub>p b \<union> \<Gamma> ` Var ` fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"
            "\<Gamma> ` Var ` bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (a#A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>) =
             \<Gamma> ` Var ` set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (b \<cdot>\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>)) \<union> \<Gamma> ` Var ` bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>)"
            "\<Gamma> ` Var ` bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (a#A) = \<Gamma> ` Var ` set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p b) \<union> \<Gamma> ` Var ` bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"
     when "a = (l,b)" for a l b and A::"('fun,'var,'a) labeled_stateful_strand"
     using that by fast+
 
   have "?A \<and> ?B \<and> ?C"
   proof (induction A)
     case (Cons a A)
     obtain l b where a: "a = (l,b)" by (metis surj_pair)
-  
+
     show ?case
       using Cons.IH wt_subst_sstp_vars_type_subset[OF assms, of b] *[OF a, of A]
       by (metis Un_mono)
   qed simp
   thus ?A ?B ?C by metis+
 qed
 
 lemma (in stateful_typed_model) fv_pair_fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_subset:
   assumes "d \<in> set D"
   shows "fv (pair (snd d)) \<subseteq> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel D)"
 using assms unfolding pair_def by (induct D) (auto simp add: unlabel_def)
 
 lemma (in stateful_typed_model) labeled_sat_ineq_lift:
   assumes "\<lbrakk>M; map (\<lambda>d. \<forall>X\<langle>\<or>\<noteq>: [(pair (t,s), pair (snd d))]\<rangle>\<^sub>s\<^sub>t) [d\<leftarrow>dbproj i D. d \<notin> set Di]\<rbrakk>\<^sub>d \<I>"
     (is "?R1 D")
   and "\<forall>(j,p) \<in> {(i,t,s)} \<union> set D \<union> set Di. \<forall>(k,q) \<in> {(i,t,s)} \<union> set D \<union> set Di.
           (\<exists>\<delta>. Unifier \<delta> (pair p) (pair q)) \<longrightarrow> j = k" (is "?R2 D")
   shows "\<lbrakk>M; map (\<lambda>d. \<forall>X\<langle>\<or>\<noteq>: [(pair (t,s), pair (snd d))]\<rangle>\<^sub>s\<^sub>t) [d\<leftarrow>D. d \<notin> set Di]\<rbrakk>\<^sub>d \<I>"
 using assms
 proof (induction D)
   case (Cons dl D)
   obtain d l where dl: "dl = (l,d)" by (metis surj_pair)
 
   have 1: "?R1 D"
   proof (cases "i = l")
     case True thus ?thesis using Cons.prems(1) dl by (cases "dl \<in> set Di") auto
   next
     case False thus ?thesis using Cons.prems(1) dl by auto
   qed
 
   have "set D \<subseteq> set (dl#D)" by auto
   hence 2: "?R2 D" using Cons.prems(2) by blast
 
   have "i \<noteq> l \<or> dl \<in> set Di \<or> \<lbrakk>M; [\<forall>X\<langle>\<or>\<noteq>: [(pair (t,s), pair (snd dl))]\<rangle>\<^sub>s\<^sub>t]\<rbrakk>\<^sub>d \<I>"
     using Cons.prems(1) dl by (auto simp add: ineq_model_def)
   moreover have "\<exists>\<delta>. Unifier \<delta> (pair (t,s)) (pair d) \<Longrightarrow> i = l"
     using Cons.prems(2) dl by force
   ultimately have 3: "dl \<in> set Di \<or> \<lbrakk>M; [\<forall>X\<langle>\<or>\<noteq>: [(pair (t,s), pair (snd dl))]\<rangle>\<^sub>s\<^sub>t]\<rbrakk>\<^sub>d \<I>"
     using strand_sem_not_unif_is_sat_ineq[of "pair (t,s)" "pair d"] dl by fastforce
 
   show ?case using Cons.IH[OF 1 2] 3 dl by auto
 qed simp
 
 lemma (in stateful_typed_model) labeled_sat_ineq_dbproj:
   assumes "\<lbrakk>M; map (\<lambda>d. \<forall>X\<langle>\<or>\<noteq>: [(pair (t,s), pair (snd d))]\<rangle>\<^sub>s\<^sub>t) [d\<leftarrow>D. d \<notin> set Di]\<rbrakk>\<^sub>d \<I>"
     (is "?P D")
   shows "\<lbrakk>M; map (\<lambda>d. \<forall>X\<langle>\<or>\<noteq>: [(pair (t,s), pair (snd d))]\<rangle>\<^sub>s\<^sub>t) [d\<leftarrow>dbproj i D. d \<notin> set Di]\<rbrakk>\<^sub>d \<I>"
     (is "?Q D")
 using assms
 proof (induction D)
   case (Cons di D)
   obtain d j where di: "di = (j,d)" by (metis surj_pair)
 
   have "?P D" using Cons.prems by (cases "di \<in> set Di") auto
   hence IH: "?Q D" by (metis Cons.IH)
 
   show ?case using di IH
   proof (cases "i = j \<and> di \<notin> set Di")
     case True
     have 1: "\<lbrakk>M; [\<forall>X\<langle>\<or>\<noteq>: [(pair (t,s), pair (snd di))]\<rangle>\<^sub>s\<^sub>t]\<rbrakk>\<^sub>d \<I>"
       using Cons.prems True by auto
     have 2: "dbproj i (di#D) = di#dbproj i D" using True dbproj_Cons(1) di by auto
     show ?thesis using 1 2 IH by auto
   qed auto
 qed simp
 
 lemma (in stateful_typed_model) labeled_sat_ineq_dbproj_sem_equiv:
   assumes "\<forall>(j,p) \<in> ((\<lambda>(t, s). (i, t, s)) ` set F') \<union> set D.
            \<forall>(k,q) \<in> ((\<lambda>(t, s). (i, t, s)) ` set F') \<union> set D.
             (\<exists>\<delta>. Unifier \<delta> (pair p) (pair q)) \<longrightarrow> j = k"
   and "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (map snd D) \<inter> set X = {}"
   shows "\<lbrakk>M; map (\<lambda>G. \<forall>X\<langle>\<or>\<noteq>: (F@G)\<rangle>\<^sub>s\<^sub>t) (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' (map snd D))\<rbrakk>\<^sub>d \<I> \<longleftrightarrow>
          \<lbrakk>M; map (\<lambda>G. \<forall>X\<langle>\<or>\<noteq>: (F@G)\<rangle>\<^sub>s\<^sub>t) (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' (map snd (dbproj i D)))\<rbrakk>\<^sub>d \<I>"
 proof -
   let ?A = "set (map snd D) \<cdot>\<^sub>p\<^sub>s\<^sub>e\<^sub>t \<I>"
   let ?B = "set (map snd (dbproj i D)) \<cdot>\<^sub>p\<^sub>s\<^sub>e\<^sub>t \<I>"
   let ?C = "set (map snd D) - set (map snd (dbproj i D))"
   let ?F = "(\<lambda>(t, s). (i, t, s)) ` set F'"
   let ?P = "\<lambda>\<delta>. subst_domain \<delta> = set X \<and> ground (subst_range \<delta>)"
 
   have 1: "\<forall>(t, t') \<in> set (map snd D). (fv t \<union> fv t') \<inter> set X = {}"
           "\<forall>(t, t') \<in> set (map snd (dbproj i D)). (fv t \<union> fv t') \<inter> set X = {}"
     using assms(2) dbproj_subset[of i D] unfolding unlabel_def by force+
 
   have 2: "?B \<subseteq> ?A" by auto
 
   have 3: "\<not>Unifier \<delta> (pair f) (pair d)"
     when f: "f \<in> set F'" and d: "d \<in> set (map snd D) - set (map snd (dbproj i D))"
     for f d and \<delta>::"('fun,'var) subst"
   proof -
     obtain k where k: "(k,d) \<in> set D - set (dbproj i D)"
       using d by force
-    
+
     have "(i,f) \<in> ((\<lambda>(t, s). (i, t, s)) ` set F') \<union> set D"
          "(k,d) \<in> ((\<lambda>(t, s). (i, t, s)) ` set F') \<union> set D"
       using f k by auto
     hence "i = k" when "Unifier \<delta> (pair f) (pair d)" for \<delta>
       using assms(1) that by blast
     moreover have "k \<noteq> i" using k d by simp
     ultimately show ?thesis by metis
   qed
 
   have "f \<cdot>\<^sub>p \<delta> \<noteq> d \<cdot>\<^sub>p \<delta>"
     when "f \<in> set F'" "d \<in> ?C" for f d and \<delta>::"('fun,'var) subst"
     by (metis fun_pair_eq_subst 3[OF that])
   hence "f \<cdot>\<^sub>p (\<delta> \<circ>\<^sub>s \<I>) \<notin> ?C \<cdot>\<^sub>p\<^sub>s\<^sub>e\<^sub>t (\<delta> \<circ>\<^sub>s \<I>)"
     when "f \<in> set F'" for f and \<delta>::"('fun,'var) subst"
     using that by blast
   moreover have "?C \<cdot>\<^sub>p\<^sub>s\<^sub>e\<^sub>t \<delta> \<cdot>\<^sub>p\<^sub>s\<^sub>e\<^sub>t \<I> = ?C \<cdot>\<^sub>p\<^sub>s\<^sub>e\<^sub>t \<I>"
     when "?P \<delta>" for \<delta>
     using assms(2) that pairs_substI[of \<delta> "(set (map snd D) - set (map snd (dbproj i D)))"]
     by blast
   ultimately have 4: "f \<cdot>\<^sub>p (\<delta> \<circ>\<^sub>s \<I>) \<notin> ?C \<cdot>\<^sub>p\<^sub>s\<^sub>e\<^sub>t \<I>"
     when "f \<in> set F'" "?P \<delta>" for f and \<delta>::"('fun,'var) subst"
     by (metis that subst_pairs_compose)
 
   { fix f and \<delta>::"('fun,'var) subst"
     assume "f \<in> set F'" "?P \<delta>"
     hence "f \<cdot>\<^sub>p (\<delta> \<circ>\<^sub>s \<I>) \<notin> ?C \<cdot>\<^sub>p\<^sub>s\<^sub>e\<^sub>t \<I>" by (metis 4)
     hence "f \<cdot>\<^sub>p (\<delta> \<circ>\<^sub>s \<I>) \<notin> ?A - ?B" by force
   } hence 5: "\<forall>f\<in>set F'. \<forall>\<delta>. ?P \<delta> \<longrightarrow> f \<cdot>\<^sub>p (\<delta> \<circ>\<^sub>s \<I>) \<notin> ?A - ?B" by metis
 
   show ?thesis
     using negchecks_model_db_subset[OF 2]
           negchecks_model_db_supset[OF 2 5]
           tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_sem_equiv[OF 1(1)]
           tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_sem_equiv[OF 1(2)]
           tr_NegChecks_constr_iff(1)
           strand_sem_eq_defs(2)
     by (metis (no_types, lifting))
 qed
 
 lemma (in stateful_typed_model) labeled_sat_eqs_list_all:
   assumes "\<forall>(j, p) \<in> {(i,t,s)} \<union> set D. \<forall>(k,q) \<in> {(i,t,s)} \<union> set D.
               (\<exists>\<delta>. Unifier \<delta> (pair p) (pair q)) \<longrightarrow> j = k" (is "?P D")
   and "\<lbrakk>M; map (\<lambda>d. \<langle>ac: (pair (t,s)) \<doteq> (pair (snd d))\<rangle>\<^sub>s\<^sub>t) D\<rbrakk>\<^sub>d \<I>" (is "?Q D")
   shows "list_all (\<lambda>d. fst d = i) D"
 using assms
 proof (induction D rule: List.rev_induct)
   case (snoc di D)
   obtain d j where di: "di = (j,d)" by (metis surj_pair)
   have "pair (t,s) \<cdot> \<I> = pair d \<cdot> \<I>" using di snoc.prems(2) by auto
   hence "\<exists>\<delta>. Unifier \<delta> (pair (t,s)) (pair d)" by auto
   hence 1: "i = j" using snoc.prems(1) di by fastforce
-  
+
   have "set D \<subseteq> set (D@[di])" by auto
   hence 2: "?P D" using snoc.prems(1) by blast
 
   have 3: "?Q D" using snoc.prems(2) by auto
-  
+
   show ?case using di 1 snoc.IH[OF 2 3] by simp
 qed simp
 
 lemma (in stateful_typed_model) labeled_sat_eqs_subseqs:
   assumes "Di \<in> set (subseqs D)"
   and "\<forall>(j, p) \<in> {(i,t,s)} \<union> set D. \<forall>(k, q) \<in> {(i,t,s)} \<union> set D.
           (\<exists>\<delta>. Unifier \<delta> (pair p) (pair q)) \<longrightarrow> j = k" (is "?P D")
   and "\<lbrakk>M; map (\<lambda>d. \<langle>ac: (pair (t,s)) \<doteq> (pair (snd d))\<rangle>\<^sub>s\<^sub>t) Di\<rbrakk>\<^sub>d \<I>"
   shows "Di \<in> set (subseqs (dbproj i D))"
 proof -
   have "set Di \<subseteq> set D" by (rule subseqs_subset[OF assms(1)])
   hence "?P Di" using assms(2) by blast
   thus ?thesis using labeled_sat_eqs_list_all[OF _ assms(3)] subseqs_mem_dbproj[OF assms(1)] by simp
 qed
 
 lemma (in stateful_typed_model) dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p:
   assumes "list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (unlabel S)"
   shows "list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t S))"
 using assms
 proof (induction S)
   case (Cons a S)
   have prems: "tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (snd a)" "list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (unlabel S)"
     using Cons.prems unlabel_Cons(2)[of a S] by simp_all
   hence IH: "list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t S))" by (metis Cons.IH)
 
   obtain l b where a: "a = (l,b)" by (metis surj_pair)
   with Cons show ?case
   proof (cases b)
     case (Equality c t t')
     hence "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (a#S) = a#dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t S" by (metis dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_Cons(3) a)
     thus ?thesis using a IH prems by fastforce
   next
     case (NegChecks X F G)
     hence "dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t (a#S) = a#dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t S" by (metis dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_Cons(7) a)
     thus ?thesis using a IH prems by fastforce
   qed auto
 qed simp
 
 lemma (in stateful_typed_model) setops\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq:
   "setops\<^sub>s\<^sub>s\<^sub>t (unlabel (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)) = setops\<^sub>s\<^sub>s\<^sub>t (unlabel A)"
 proof (induction A)
   case (Cons a A)
   obtain l b where a: "a = (l,b)" by (metis surj_pair)
   thus ?case using Cons.IH by (cases b) (simp_all add: setops\<^sub>s\<^sub>s\<^sub>t_def)
 qed simp
 
 
 subsection \<open>Locale Setup and Definitions\<close>
 locale labeled_stateful_typed_model =
   stateful_typed_model arity public Ana \<Gamma> Pair
 + labeled_typed_model arity public Ana \<Gamma> label_witness1 label_witness2
   for arity::"'fun \<Rightarrow> nat"
   and public::"'fun \<Rightarrow> bool"
   and Ana::"('fun,'var) term \<Rightarrow> (('fun,'var) term list \<times> ('fun,'var) term list)"
   and \<Gamma>::"('fun,'var) term \<Rightarrow> ('fun,'atom::finite) term_type"
   and Pair::"'fun"
   and label_witness1::"'lbl"
   and label_witness2::"'lbl"
 begin
 
 definition lpair where
   "lpair lp \<equiv> case lp of (i,p) \<Rightarrow> (i,pair p)"
 
 lemma setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p_pair_image[simp]:
   "lpair ` (setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (i,send\<langle>t\<rangle>)) = {}"
   "lpair ` (setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (i,receive\<langle>t\<rangle>)) = {}"
   "lpair ` (setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (i,\<langle>ac: t \<doteq> t'\<rangle>)) = {}"
   "lpair ` (setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (i,insert\<langle>t,s\<rangle>)) = {(i, pair (t,s))}"
   "lpair ` (setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (i,delete\<langle>t,s\<rangle>)) = {(i, pair (t,s))}"
   "lpair ` (setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (i,\<langle>ac: t \<in> s\<rangle>)) = {(i, pair (t,s))}"
   "lpair ` (setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (i,\<forall>X\<langle>\<or>\<noteq>: F \<or>\<notin>: F'\<rangle>)) = ((\<lambda>(t,s). (i, pair (t,s))) ` set F')"
 unfolding lpair_def by force+
 
 definition par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t where
-  "par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A>::('fun,'var,'lbl) labeled_stateful_strand) (Secrets::('fun,'var) terms) \<equiv> 
+  "par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t (\<A>::('fun,'var,'lbl) labeled_stateful_strand) (Secrets::('fun,'var) terms) \<equiv>
     (\<forall>l1 l2. l1 \<noteq> l2 \<longrightarrow>
               GSMP_disjoint (trms\<^sub>s\<^sub>s\<^sub>t (proj_unl l1 \<A>) \<union> pair ` setops\<^sub>s\<^sub>s\<^sub>t (proj_unl l1 \<A>))
                             (trms\<^sub>s\<^sub>s\<^sub>t (proj_unl l2 \<A>) \<union> pair ` setops\<^sub>s\<^sub>s\<^sub>t (proj_unl l2 \<A>)) Secrets) \<and>
     ground Secrets \<and> (\<forall>s \<in> Secrets. \<forall>s' \<in> subterms s. {} \<turnstile>\<^sub>c s' \<or> s' \<in> Secrets) \<and>
     (\<forall>(i,p) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>. \<forall>(j,q) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>.
       (\<exists>\<delta>. Unifier \<delta> (pair p) (pair q)) \<longrightarrow> i = j)"
 
 definition declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t where
   "declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I> \<equiv> {t. \<langle>\<star>, receive\<langle>t\<rangle>\<rangle> \<in> set \<A>} \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>"
 
 definition strand_leaks\<^sub>l\<^sub>s\<^sub>s\<^sub>t ("_ leaks _ under _") where
   "(\<A>::('fun,'var,'lbl) labeled_stateful_strand) leaks Secrets under \<I> \<equiv>
     (\<exists>t \<in> Secrets - declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<I>. \<exists>n. \<I> \<Turnstile>\<^sub>s (proj_unl n \<A>@[send\<langle>t\<rangle>]))"
 
 definition typing_cond\<^sub>s\<^sub>s\<^sub>t where
   "typing_cond\<^sub>s\<^sub>s\<^sub>t \<A> \<equiv> wf\<^sub>s\<^sub>s\<^sub>t \<A> \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>s\<^sub>t \<A>) \<and> tfr\<^sub>s\<^sub>s\<^sub>t \<A>"
 
 type_synonym ('a,'b,'c) labeleddbstate = "('c strand_label \<times> (('a,'b) term \<times> ('a,'b) term)) set"
 type_synonym ('a,'b,'c) labeleddbstatelist = "('c strand_label \<times> (('a,'b) term \<times> ('a,'b) term)) list"
 
 text \<open>
   For proving the compositionality theorem for stateful constraints the idea is to first define a
   variant of the reduction technique that was used to establish the stateful typing result. This
   variant performs database-state projections, and it allows us to reduce the compositionality
   problem for stateful constraints to ordinary constraints.
 \<close>
 fun tr\<^sub>p\<^sub>c::
   "('fun,'var,'lbl) labeled_stateful_strand \<Rightarrow> ('fun,'var,'lbl) labeleddbstatelist
    \<Rightarrow> ('fun,'var,'lbl) labeled_strand list"
 where
   "tr\<^sub>p\<^sub>c [] D = [[]]"
 | "tr\<^sub>p\<^sub>c ((i,send\<langle>t\<rangle>)#A) D = map ((#) (i,send\<langle>t\<rangle>\<^sub>s\<^sub>t)) (tr\<^sub>p\<^sub>c A D)"
 | "tr\<^sub>p\<^sub>c ((i,receive\<langle>t\<rangle>)#A) D = map ((#) (i,receive\<langle>t\<rangle>\<^sub>s\<^sub>t)) (tr\<^sub>p\<^sub>c A D)"
 | "tr\<^sub>p\<^sub>c ((i,\<langle>ac: t \<doteq> t'\<rangle>)#A) D = map ((#) (i,\<langle>ac: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t)) (tr\<^sub>p\<^sub>c A D)"
 | "tr\<^sub>p\<^sub>c ((i,insert\<langle>t,s\<rangle>)#A) D = tr\<^sub>p\<^sub>c A (List.insert (i,(t,s)) D)"
 | "tr\<^sub>p\<^sub>c ((i,delete\<langle>t,s\<rangle>)#A) D = (
     concat (map (\<lambda>Di. map (\<lambda>B. (map (\<lambda>d. (i,\<langle>check: (pair (t,s)) \<doteq> (pair (snd d))\<rangle>\<^sub>s\<^sub>t)) Di)@
                                (map (\<lambda>d. (i,\<forall>[]\<langle>\<or>\<noteq>: [(pair (t,s), pair (snd d))]\<rangle>\<^sub>s\<^sub>t))
                                     [d\<leftarrow>dbproj i D. d \<notin> set Di])@B)
                           (tr\<^sub>p\<^sub>c A [d\<leftarrow>D. d \<notin> set Di]))
                 (subseqs (dbproj i D))))"
 | "tr\<^sub>p\<^sub>c ((i,\<langle>ac: t \<in> s\<rangle>)#A) D =
     concat (map (\<lambda>B. map (\<lambda>d. (i,\<langle>ac: (pair (t,s)) \<doteq> (pair (snd d))\<rangle>\<^sub>s\<^sub>t)#B) (dbproj i D)) (tr\<^sub>p\<^sub>c A D))"
 | "tr\<^sub>p\<^sub>c ((i,\<forall>X\<langle>\<or>\<noteq>: F \<or>\<notin>: F' \<rangle>)#A) D =
     map ((@) (map (\<lambda>G. (i,\<forall>X\<langle>\<or>\<noteq>: (F@G)\<rangle>\<^sub>s\<^sub>t)) (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' (map snd (dbproj i D))))) (tr\<^sub>p\<^sub>c A D)"
 
 
 subsection \<open>Small Lemmata\<close>
 lemma par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_nil:
   assumes "ground Sec" "\<forall>s \<in> Sec. \<forall>s'\<in>subterms s. {} \<turnstile>\<^sub>c s' \<or> s' \<in> Sec"
   shows "par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t [] Sec"
 using assms unfolding par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by simp
 
 lemma par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subset:
   assumes A: "par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t A Sec"
     and BA: "set B \<subseteq> set A"
   shows "par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t B Sec"
 proof -
   let ?L = "\<lambda>n A. trms\<^sub>s\<^sub>s\<^sub>t (proj_unl n A) \<union> pair ` setops\<^sub>s\<^sub>s\<^sub>t (proj_unl n A)"
 
   have "?L n B \<subseteq> ?L n A" for n
     using trms\<^sub>s\<^sub>s\<^sub>t_mono[OF proj_set_mono(2)[OF BA]] setops\<^sub>s\<^sub>s\<^sub>t_mono[OF proj_set_mono(2)[OF BA]]
     by blast
   hence "GSMP_disjoint (?L m B) (?L n B) Sec" when nm: "m \<noteq> n" for n m::'lbl
     using GSMP_disjoint_subset[of "?L m A" "?L n A" Sec "?L m B" "?L n B"] A nm
     unfolding par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by simp
   thus "par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t B Sec"
     using A setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_mono[OF BA]
     unfolding par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by blast
 qed
 
 lemma par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_split:
   assumes "par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A@B) Sec"
   shows "par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t A Sec" "par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t B Sec"
 using par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subset[OF assms] by simp_all
 
 lemma par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_proj:
   assumes "par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t A Sec"
   shows "par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t (proj n A) Sec"
 using par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subset[OF assms] by simp
 
 lemma par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t:
   assumes A: "par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t A S"
   shows "par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A) S"
 proof (unfold par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def case_prod_unfold; intro conjI)
   show "ground S" "\<forall>s \<in> S. \<forall>s' \<in> subterms s. {} \<turnstile>\<^sub>c s' \<or> s' \<in> S"
     using A unfolding par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by fast+
 
   let ?M = "\<lambda>l B. (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (proj l B) \<union> pair ` setops\<^sub>s\<^sub>s\<^sub>t (proj_unl l B))"
   let ?P = "\<lambda>B. \<forall>l1 l2. l1 \<noteq> l2 \<longrightarrow> GSMP_disjoint (?M l1 B) (?M l2 B) S"
   let ?Q = "\<lambda>B. \<forall>p \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t B. \<forall>q \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t B.
     (\<exists>\<delta>. Unifier \<delta> (pair (snd p)) (pair (snd q))) \<longrightarrow> fst p = fst q"
 
   have "?P A" "?Q A" using A unfolding par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def case_prod_unfold by blast+
   thus "?P (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)" "?Q (dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)"
     by (metis setops\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq trms\<^sub>s\<^sub>s\<^sub>t_unlabel_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq proj_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t,
         metis setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_dual\<^sub>l\<^sub>s\<^sub>s\<^sub>t_eq)
 qed
 
 lemma par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_subst:
   assumes A: "par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t A S"
     and \<delta>: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)" "subst_domain \<delta> \<inter> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A = {}"
   shows "par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>) S"
 proof (unfold par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def case_prod_unfold; intro conjI)
   show "ground S" "\<forall>s \<in> S. \<forall>s' \<in> subterms s. {} \<turnstile>\<^sub>c s' \<or> s' \<in> S"
     using A unfolding par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by fast+
 
   let ?N = "\<lambda>l B. trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (proj l B) \<union> pair ` setops\<^sub>s\<^sub>s\<^sub>t (proj_unl l B)"
   define M where "M \<equiv> \<lambda>l (B::('fun,'var,'lbl) labeled_stateful_strand). ?N l B"
   let ?P = "\<lambda>p q. \<exists>\<delta>. Unifier \<delta> (pair (snd p)) (pair (snd q))"
   let ?Q = "\<lambda>B. \<forall>p \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t B. \<forall>q \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t B. ?P p q \<longrightarrow> fst p = fst q"
   let ?R = "\<lambda>B. \<forall>l1 l2. l1 \<noteq> l2 \<longrightarrow> GSMP_disjoint (?N l1 B) (?N l2 B) S"
 
   have d: "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (proj l A) \<inter> subst_domain \<delta> = {}" for l
     using \<delta>(3) unfolding proj_def bvars\<^sub>s\<^sub>s\<^sub>t_def unlabel_def by auto
 
   have "GSMP_disjoint (M l1 A) (M l2 A) S" when l: "l1 \<noteq> l2" for l1 l2
     using l A unfolding par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def M_def by presburger
   moreover have "M l (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>) = (M l A) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<delta>" for l
     using fun_pair_subst_set[of \<delta> "setops\<^sub>s\<^sub>s\<^sub>t (proj_unl l A)", symmetric]
           trms\<^sub>s\<^sub>s\<^sub>t_subst[OF d[of l]] setops\<^sub>s\<^sub>s\<^sub>t_subst[OF d[of l]] proj_subst[of l A \<delta>]
     unfolding M_def unlabel_subst by auto
   ultimately have "GSMP_disjoint (M l1 (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>)) (M l2 (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>)) S" when l: "l1 \<noteq> l2" for l1 l2
     using l GSMP_wt_subst_subset[OF _ \<delta>(1,2), of _ "M l1 A"]
           GSMP_wt_subst_subset[OF _ \<delta>(1,2), of _ "M l2 A"]
     unfolding GSMP_disjoint_def by fastforce
   thus "?R (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>)" unfolding M_def by blast
 
-  have "?Q A" using A unfolding par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by force 
+  have "?Q A" using A unfolding par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by force
   thus "?Q (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>)" using \<delta>(3)
   proof (induction A)
     case (Cons a A)
     obtain l b where a: "a = (l,b)" by (metis surj_pair)
 
     have 0: "bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (a#A) = set (bvars\<^sub>s\<^sub>s\<^sub>t\<^sub>p (snd a)) \<union> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"
       unfolding bvars\<^sub>s\<^sub>s\<^sub>t_def unlabel_def by simp
 
     have "?Q A" "subst_domain \<delta> \<inter> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t A = {}"
       using Cons.prems 0 unfolding setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by auto
     hence IH: "?Q (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>)" using Cons.IH unfolding setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by blast
-    
+
     have 1: "fst p = fst q"
       when p: "p \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>)"
         and q: "q \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>)"
         and pq: "?P p q"
       for p q
       using a p q pq by (cases b) auto
 
     have 2: "fst p = fst q"
       when p: "p \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>)"
         and q: "q \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p (a \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>)"
         and pq: "?P p q"
       for p q
     proof -
       obtain p' X where p':
-          "p' \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" "fst p = fst p'" 
+          "p' \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" "fst p = fst p'"
           "X \<subseteq> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (a#A)" "snd p = snd p' \<cdot>\<^sub>p rm_vars X \<delta>"
         using setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_in_subst[OF p] 0 by blast
 
       obtain q' Y where q':
-          "q' \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p a" "fst q = fst q'" 
+          "q' \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p a" "fst q = fst q'"
           "Y \<subseteq> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t (a#A)" "snd q = snd q' \<cdot>\<^sub>p rm_vars Y \<delta>"
         using setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p_in_subst[OF q] 0 by blast
 
       have "pair (snd p) = pair (snd p') \<cdot> \<delta>"
            "pair (snd q) = pair (snd q') \<cdot> \<delta>"
         using fun_pair_subst[of "snd p'" "rm_vars X \<delta>"] fun_pair_subst[of "snd q'" "rm_vars Y \<delta>"]
               p'(3,4) q'(3,4) Cons.prems(2) rm_vars_apply'[of \<delta> X] rm_vars_apply'[of \<delta> Y]
         by fastforce+
       hence "\<exists>\<delta>. Unifier \<delta> (pair (snd p')) (pair (snd q'))"
         using pq Unifier_comp' by metis
       thus ?thesis using Cons.prems p'(1,2) q'(1,2) by simp
     qed
 
     show ?case by (metis 1 2 IH Un_iff setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_cons subst_lsst_cons)
   qed simp
 qed
 
 lemma wf_pair_negchecks_map':
   assumes "wf\<^sub>s\<^sub>t X (unlabel A)"
   shows "wf\<^sub>s\<^sub>t X (unlabel (map (\<lambda>G. (i,\<forall>Y\<langle>\<or>\<noteq>: (F@G)\<rangle>\<^sub>s\<^sub>t)) M@A))"
 using assms by (induct M) auto
 
 lemma wf_pair_eqs_ineqs_map':
   fixes A::"('fun,'var,'lbl) labeled_strand"
   assumes "wf\<^sub>s\<^sub>t X (unlabel A)"
           "Di \<in> set (subseqs (dbproj i D))"
           "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel D) \<subseteq> X"
   shows "wf\<^sub>s\<^sub>t X (unlabel (
             (map (\<lambda>d. (i,\<langle>check: (pair (t,s)) \<doteq> (pair (snd d))\<rangle>\<^sub>s\<^sub>t)) Di)@
             (map (\<lambda>d. (i,\<forall>[]\<langle>\<or>\<noteq>: [(pair (t,s), pair (snd d))]\<rangle>\<^sub>s\<^sub>t)) [d\<leftarrow>dbproj i D. d \<notin> set Di])@A))"
 proof -
   let ?f = "[d\<leftarrow>dbproj i D. d \<notin> set Di]"
   define c1 where c1: "c1 = map (\<lambda>d. (i,\<langle>check: (pair (t,s)) \<doteq> (pair (snd d))\<rangle>\<^sub>s\<^sub>t)) Di"
   define c2 where c2: "c2 = map (\<lambda>d. (i,\<forall>[]\<langle>\<or>\<noteq>: [(pair (t,s), pair (snd d))]\<rangle>\<^sub>s\<^sub>t)) ?f"
   define c3 where c3: "c3 = map (\<lambda>d. \<langle>check: (pair (t,s)) \<doteq> (pair d)\<rangle>\<^sub>s\<^sub>t) (unlabel Di)"
   define c4 where c4: "c4 = map (\<lambda>d. \<forall>[]\<langle>\<or>\<noteq>: [(pair (t,s), pair d)]\<rangle>\<^sub>s\<^sub>t) (unlabel ?f)"
   have ci_eqs: "c3 = unlabel c1" "c4 = unlabel c2" unfolding c1 c2 c3 c4 unlabel_def by auto
   have 1: "wf\<^sub>s\<^sub>t X (unlabel (c2@A))"
     using wf_fun_pair_ineqs_map[OF assms(1)] ci_eqs(2) unlabel_append[of c2 A] c4
     by metis
-  have 2: "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel Di) \<subseteq> X" 
+  have 2: "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel Di) \<subseteq> X"
     using assms(3) subseqs_set_subset(1)[OF assms(2)]
-    unfolding unlabel_def 
+    unfolding unlabel_def
     by fastforce
   { fix B::"('fun,'var) strand" assume "wf\<^sub>s\<^sub>t X B"
     hence "wf\<^sub>s\<^sub>t X (unlabel c1@B)" using 2 unfolding c1 unlabel_def by (induct Di) auto
   } thus ?thesis using 1 unfolding c1 c2 unlabel_def by simp
 qed
 
 lemma trms\<^sub>s\<^sub>s\<^sub>t_setops\<^sub>s\<^sub>s\<^sub>t_wt_instance_ex:
   defines "M \<equiv> \<lambda>A. trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<union> pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A)"
   assumes B: "\<forall>b \<in> set B. \<exists>a \<in> set A. \<exists>\<delta>. b = a \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta> \<and> wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta> \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)"
   shows "\<forall>t \<in> M B. \<exists>s \<in> M A. \<exists>\<delta>. t = s \<cdot> \<delta> \<and> wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta> \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)"
 proof
   let ?P = "\<lambda>\<delta>. wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta> \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)"
 
   fix t assume "t \<in> M B"
   then obtain b where b: "b \<in> set B" "t \<in> trms\<^sub>s\<^sub>s\<^sub>t\<^sub>p (snd b) \<union> pair ` setops\<^sub>s\<^sub>s\<^sub>t\<^sub>p (snd b)"
     unfolding M_def unfolding unlabel_def trms\<^sub>s\<^sub>s\<^sub>t_def setops\<^sub>s\<^sub>s\<^sub>t_def by auto
   then obtain a \<delta> where a: "a \<in> set A" "b = a \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>" and \<delta>: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)"
     using B by meson
 
   note \<delta>' = wt_subst_rm_vars[OF \<delta>(1)] wf_trms_subst_rm_vars'[OF \<delta>(2)]
 
   have "t \<in> M (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>)"
     using b(2) a
     unfolding M_def subst_apply_labeled_stateful_strand_def unlabel_def trms\<^sub>s\<^sub>s\<^sub>t_def setops\<^sub>s\<^sub>s\<^sub>t_def
     by auto
   moreover have "\<exists>s \<in> M A. \<exists>\<delta>. t = s \<cdot> \<delta> \<and> ?P \<delta>" when "t \<in> trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>)"
     using trms\<^sub>s\<^sub>s\<^sub>t_unlabel_subst'[OF that] \<delta>' unfolding M_def by blast
   moreover have "\<exists>s \<in> M A. \<exists>\<delta>. t = s \<cdot> \<delta> \<and> ?P \<delta>" when t: "t \<in> pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A \<cdot>\<^sub>s\<^sub>s\<^sub>t \<delta>)"
   proof -
     obtain p where p: "p \<in> setops\<^sub>s\<^sub>s\<^sub>t (unlabel A \<cdot>\<^sub>s\<^sub>s\<^sub>t \<delta>)" "t = pair p" using t by blast
     then obtain q X where q: "q \<in> setops\<^sub>s\<^sub>s\<^sub>t (unlabel A)" "p = q \<cdot>\<^sub>p rm_vars (set X) \<delta>"
       using setops\<^sub>s\<^sub>s\<^sub>t_subst'[OF p(1)] by blast
     hence "t = pair q \<cdot> rm_vars (set X) \<delta>"
       using fun_pair_subst[of q "rm_vars (set X) \<delta>"] p(2) by presburger
     thus ?thesis using \<delta>'[of "set X"] q(1) unfolding M_def by blast
   qed
   ultimately show "\<exists>s \<in> M A. \<exists>\<delta>. t = s \<cdot> \<delta> \<and> ?P \<delta>" unfolding M_def unlabel_subst by fast
 qed
 
 lemma setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_wt_instance_ex:
   assumes B: "\<forall>b \<in> set B. \<exists>a \<in> set A. \<exists>\<delta>. b = a \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta> \<and> wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta> \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)"
   shows "\<forall>p \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t B. \<exists>q \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A. \<exists>\<delta>.
     fst p = fst q \<and> snd p = snd q \<cdot>\<^sub>p \<delta> \<and> wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta> \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)"
 proof
   let ?P = "\<lambda>\<delta>. wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta> \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)"
 
   fix p assume "p \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t B"
   then obtain b where b: "b \<in> set B" "p \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p b" unfolding setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by blast
   then obtain a \<delta> where a: "a \<in> set A" "b = a \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta>" and \<delta>: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)"
     using B by meson
   hence p: "p \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t (A \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<delta>)"
     using b(2) unfolding setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def subst_apply_labeled_stateful_strand_def by auto
-  
+
   obtain X q where q:
       "q \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" "fst p = fst q" "snd p = snd q \<cdot>\<^sub>p rm_vars X \<delta>"
     using setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_in_subst[OF p] by blast
 
   show "\<exists>q \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A. \<exists>\<delta>. fst p = fst q \<and> snd p = snd q \<cdot>\<^sub>p \<delta> \<and> ?P \<delta>"
     using q wt_subst_rm_vars[OF \<delta>(1)] wf_trms_subst_rm_vars'[OF \<delta>(2)] by blast
 qed
 
 
 subsection \<open>Lemmata: Properties of the Constraint Translation Function\<close>
 lemma tr_par_labeled_rcv_iff:
   "B \<in> set (tr\<^sub>p\<^sub>c A D) \<Longrightarrow> (i, receive\<langle>t\<rangle>\<^sub>s\<^sub>t) \<in> set B \<longleftrightarrow> (i, receive\<langle>t\<rangle>) \<in> set A"
 by (induct A D arbitrary: B rule: tr\<^sub>p\<^sub>c.induct) auto
 
 lemma tr_par_declassified_eq:
   "B \<in> set (tr\<^sub>p\<^sub>c A D) \<Longrightarrow> declassified\<^sub>l\<^sub>s\<^sub>t B I = declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t A I"
 using tr_par_labeled_rcv_iff unfolding declassified\<^sub>l\<^sub>s\<^sub>t_def declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by simp
 
 lemma tr_par_ik_eq:
   assumes "B \<in> set (tr\<^sub>p\<^sub>c A D)"
   shows "ik\<^sub>s\<^sub>t (unlabel B) = ik\<^sub>s\<^sub>s\<^sub>t (unlabel A)"
 proof -
   have "{t. \<exists>i. (i, receive\<langle>t\<rangle>\<^sub>s\<^sub>t) \<in> set B} = {t. \<exists>i. (i, receive\<langle>t\<rangle>) \<in> set A}"
     using tr_par_labeled_rcv_iff[OF assms] by simp
   moreover have
       "\<And>C. {t. \<exists>i. (i, receive\<langle>t\<rangle>\<^sub>s\<^sub>t) \<in> set C} = {t. receive\<langle>t\<rangle>\<^sub>s\<^sub>t \<in> set (unlabel C)}"
       "\<And>C. {t. \<exists>i. (i, receive\<langle>t\<rangle>) \<in> set C} = {t. receive\<langle>t\<rangle> \<in> set (unlabel C)}"
     unfolding unlabel_def by force+
   ultimately show ?thesis by (metis ik\<^sub>s\<^sub>s\<^sub>t_def ik\<^sub>s\<^sub>t_is_rcv_set)
 qed
 
 lemma tr_par_deduct_iff:
   assumes "B \<in> set (tr\<^sub>p\<^sub>c A D)"
   shows "ik\<^sub>s\<^sub>t (unlabel B) \<cdot>\<^sub>s\<^sub>e\<^sub>t I \<turnstile> t \<longleftrightarrow> ik\<^sub>s\<^sub>s\<^sub>t (unlabel A) \<cdot>\<^sub>s\<^sub>e\<^sub>t I \<turnstile> t"
 using tr_par_ik_eq[OF assms] by metis
 
 lemma tr_par_vars_subset:
   assumes "A' \<in> set (tr\<^sub>p\<^sub>c A D)"
   shows "fv\<^sub>l\<^sub>s\<^sub>t A' \<subseteq> fv\<^sub>s\<^sub>s\<^sub>t (unlabel A) \<union> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel D)" (is ?P)
   and "bvars\<^sub>l\<^sub>s\<^sub>t A' \<subseteq> bvars\<^sub>s\<^sub>s\<^sub>t (unlabel A)" (is ?Q)
 proof -
   show ?P using assms
   proof (induction "unlabel A" arbitrary: A A' D rule: strand_sem_stateful_induct)
     case (ConsIn A' D ac t s AA A A')
     then obtain i B where iB: "A = (i,\<langle>ac: t \<in> s\<rangle>)#B" "AA = unlabel B"
       unfolding unlabel_def by moura
     then obtain A'' d where *:
         "d \<in> set (dbproj i D)"
         "A' = (i,\<langle>ac: (pair (t,s)) \<doteq> (pair (snd d))\<rangle>\<^sub>s\<^sub>t)#A''"
         "A'' \<in> set (tr\<^sub>p\<^sub>c B D)"
       using ConsIn.prems(1) by moura
     hence "fv\<^sub>l\<^sub>s\<^sub>t A'' \<subseteq> fv\<^sub>s\<^sub>s\<^sub>t (unlabel B) \<union> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel D)"
           "fv (pair (snd d)) \<subseteq> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel D)"
       apply (metis ConsIn.hyps(1)[OF iB(2)])
       using fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_mono[OF dbproj_subset[of i D]]
             fv_pair_fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_subset[OF *(1)]
       by blast
     thus ?case using * iB unfolding pair_def by auto
   next
     case (ConsDel A' D t s AA A A')
     then obtain i B where iB: "A = (i,delete\<langle>t,s\<rangle>)#B" "AA = unlabel B"
       unfolding unlabel_def by moura
 
     define fltD1 where "fltD1 = (\<lambda>Di. filter (\<lambda>d. d \<notin> set Di) D)"
     define fltD2 where "fltD2 = (\<lambda>Di. filter (\<lambda>d. d \<notin> set Di) (dbproj i D))"
     define constr where "constr =
       (\<lambda>Di. (map (\<lambda>d. (i, \<langle>check: (pair (t,s)) \<doteq> (pair (snd d))\<rangle>\<^sub>s\<^sub>t)) Di)@
             (map (\<lambda>d. (i, \<forall>[]\<langle>\<or>\<noteq>: [(pair (t,s), pair (snd d))]\<rangle>\<^sub>s\<^sub>t)) (fltD2 Di)))"
 
     from iB obtain A'' Di where *:
         "Di \<in> set (subseqs (dbproj i D))" "A' = (constr Di)@A''" "A'' \<in> set (tr\<^sub>p\<^sub>c B (fltD1 Di))"
       using ConsDel.prems(1) unfolding constr_def fltD1_def fltD2_def by moura
     hence "fv\<^sub>l\<^sub>s\<^sub>t A'' \<subseteq> fv\<^sub>s\<^sub>s\<^sub>t AA \<union> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel (fltD1 Di))"
       unfolding constr_def fltD1_def by (metis ConsDel.hyps(1) iB(2))
     hence 1: "fv\<^sub>l\<^sub>s\<^sub>t A'' \<subseteq> fv\<^sub>s\<^sub>s\<^sub>t AA \<union> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel D)"
       using fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_mono[of "unlabel (fltD1 Di)" "unlabel D"]
       unfolding unlabel_def fltD1_def by force
-    
+
     have 2: "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel Di) \<union> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel (fltD1 Di)) \<subseteq> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel D)"
       using subseqs_set_subset(1)[OF *(1)]
       unfolding fltD1_def unlabel_def
       by auto
 
     have 5: "fv\<^sub>l\<^sub>s\<^sub>t A' = fv\<^sub>l\<^sub>s\<^sub>t (constr Di) \<union> fv\<^sub>l\<^sub>s\<^sub>t A''" using * unfolding unlabel_def by force
 
     have "fv\<^sub>l\<^sub>s\<^sub>t (constr Di) \<subseteq> fv t \<union> fv s \<union> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel Di) \<union> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel (fltD1 Di))"
       unfolding unlabel_def constr_def fltD1_def fltD2_def pair_def by auto
     hence 3: "fv\<^sub>l\<^sub>s\<^sub>t (constr Di) \<subseteq> fv t \<union> fv s \<union> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel D)" using 2 by blast
 
     have 4: "fv\<^sub>s\<^sub>s\<^sub>t (unlabel A) = fv t \<union> fv s \<union> fv\<^sub>s\<^sub>s\<^sub>t AA" using iB by auto
-    
+
     have "fv\<^sub>s\<^sub>t (unlabel A') \<subseteq> fv\<^sub>s\<^sub>s\<^sub>t (unlabel A) \<union> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel D)" using 1 3 4 5 by blast
     thus ?case by metis
   next
     case (ConsNegChecks A' D X F F' AA A A')
     then obtain i B where iB: "A = (i,NegChecks X F F')#B" "AA = unlabel B"
       unfolding unlabel_def by moura
 
     define D' where "D' \<equiv> \<Union>(fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s ` set (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' (unlabel (dbproj i D))))"
     define constr where "constr = map (\<lambda>G. (i,\<forall>X\<langle>\<or>\<noteq>: (F@G)\<rangle>\<^sub>s\<^sub>t)) (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' (map snd (dbproj i D)))"
 
     from iB obtain A'' where *: "A'' \<in> set (tr\<^sub>p\<^sub>c B D)" "A' = constr@A''"
       using ConsNegChecks.prems(1) unfolding constr_def by moura
     hence "fv\<^sub>l\<^sub>s\<^sub>t A'' \<subseteq> fv\<^sub>s\<^sub>s\<^sub>t AA \<union> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel D)"
       by (metis ConsNegChecks.hyps(1) iB(2))
     hence **: "fv\<^sub>l\<^sub>s\<^sub>t A'' \<subseteq> fv\<^sub>s\<^sub>s\<^sub>t AA \<union> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel D)" by auto
 
     have 1: "fv\<^sub>l\<^sub>s\<^sub>t constr \<subseteq> (D' \<union> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F) - set X"
       unfolding D'_def constr_def unlabel_def by auto
 
     have "set (unlabel (dbproj i D)) \<subseteq> set (unlabel D)" unfolding unlabel_def by auto
     hence 2: "D' \<subseteq> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' \<union> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel D)"
       using tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_vars_subset'[of F' "unlabel (dbproj i D)"] fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_mono
       unfolding D'_def by blast
 
     have 3: "fv\<^sub>l\<^sub>s\<^sub>t A' \<subseteq> ((fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' \<union> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F) - set X) \<union> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel D) \<union> fv\<^sub>l\<^sub>s\<^sub>t A''"
       using 1 2 *(2) unfolding unlabel_def by fastforce
 
     have 4: "fv\<^sub>s\<^sub>s\<^sub>t AA \<subseteq> fv\<^sub>s\<^sub>s\<^sub>t (unlabel A)" by (metis ConsNegChecks.hyps(2) fv\<^sub>s\<^sub>s\<^sub>t_cons_subset)
 
     have 5: "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' \<union> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X \<subseteq> fv\<^sub>s\<^sub>s\<^sub>t (unlabel A)"
       using ConsNegChecks.hyps(2) unfolding unlabel_def by force
 
     show ?case using ** 3 4 5 by blast
   qed (fastforce simp add: unlabel_def)+
 
   show ?Q using assms
     apply (induct "unlabel A" arbitrary: A A' D rule: strand_sem_stateful_induct)
     by (fastforce simp add: unlabel_def)+
 qed
 
 lemma tr_par_vars_disj:
   assumes "A' \<in> set (tr\<^sub>p\<^sub>c A D)" "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel D) \<inter> bvars\<^sub>s\<^sub>s\<^sub>t (unlabel A) = {}"
   and "fv\<^sub>s\<^sub>s\<^sub>t (unlabel A) \<inter> bvars\<^sub>s\<^sub>s\<^sub>t (unlabel A) = {}"
   shows "fv\<^sub>l\<^sub>s\<^sub>t A' \<inter> bvars\<^sub>l\<^sub>s\<^sub>t A' = {}"
 using assms tr_par_vars_subset by fast
 
 lemma tr_par_trms_subset:
   assumes "A' \<in> set (tr\<^sub>p\<^sub>c A D)"
   shows "trms\<^sub>l\<^sub>s\<^sub>t A' \<subseteq> trms\<^sub>s\<^sub>s\<^sub>t (unlabel A) \<union> pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A) \<union> pair ` snd ` set D"
 using assms
 proof (induction A D arbitrary: A' rule: tr\<^sub>p\<^sub>c.induct)
   case 1 thus ?case by simp
 next
   case (2 i t A D)
   then obtain A'' where A'': "A' = (i,send\<langle>t\<rangle>\<^sub>s\<^sub>t)#A''" "A'' \<in> set (tr\<^sub>p\<^sub>c A D)" by moura
   hence "trms\<^sub>l\<^sub>s\<^sub>t A'' \<subseteq> trms\<^sub>s\<^sub>s\<^sub>t (unlabel A) \<union> pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A) \<union> pair ` snd ` set D"
     by (metis "2.IH")
   thus ?case using A'' by (auto simp add: setops\<^sub>s\<^sub>s\<^sub>t_def)
 next
   case (3 i t A D)
   then obtain A'' where A'': "A' = (i,receive\<langle>t\<rangle>\<^sub>s\<^sub>t)#A''" "A'' \<in> set (tr\<^sub>p\<^sub>c A D)"
     by moura
   hence "trms\<^sub>l\<^sub>s\<^sub>t A'' \<subseteq> trms\<^sub>s\<^sub>s\<^sub>t (unlabel A) \<union> pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A) \<union> pair ` snd ` set D"
     by (metis "3.IH")
   thus ?case using A'' by (auto simp add: setops\<^sub>s\<^sub>s\<^sub>t_def)
 next
   case (4 i ac t t' A D)
   then obtain A'' where A'': "A' = (i,\<langle>ac: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t)#A''" "A'' \<in> set (tr\<^sub>p\<^sub>c A D)"
     by moura
   hence "trms\<^sub>l\<^sub>s\<^sub>t A'' \<subseteq> trms\<^sub>s\<^sub>s\<^sub>t (unlabel A) \<union> pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A) \<union> pair ` snd ` set D"
     by (metis "4.IH")
   thus ?case using A'' by (auto simp add: setops\<^sub>s\<^sub>s\<^sub>t_def)
 next
   case (5 i t s A D)
   hence "A' \<in> set (tr\<^sub>p\<^sub>c A (List.insert (i,t,s) D))" by simp
   hence "trms\<^sub>l\<^sub>s\<^sub>t A' \<subseteq> trms\<^sub>s\<^sub>s\<^sub>t (unlabel A) \<union> pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A) \<union>
                       pair ` snd ` set (List.insert (i,t,s) D)"
     by (metis "5.IH")
   thus ?case by (auto simp add: setops\<^sub>s\<^sub>s\<^sub>t_def)
 next
   case (6 i t s A D)
   from 6 obtain Di A'' B C where A'':
       "Di \<in> set (subseqs (dbproj i D))" "A'' \<in> set (tr\<^sub>p\<^sub>c A [d\<leftarrow>D. d \<notin> set Di])" "A' = (B@C)@A''"
       "B = map (\<lambda>d. (i,\<langle>check: (pair (t,s)) \<doteq> (pair (snd d))\<rangle>\<^sub>s\<^sub>t)) Di"
       "C = map (\<lambda>d. (i,\<forall>[]\<langle>\<or>\<noteq>: [(pair (t,s), pair (snd d))]\<rangle>\<^sub>s\<^sub>t)) [d\<leftarrow>dbproj i D. d \<notin> set Di]"
     by moura
   hence "trms\<^sub>l\<^sub>s\<^sub>t A'' \<subseteq> trms\<^sub>s\<^sub>s\<^sub>t (unlabel A) \<union> pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A) \<union>
                        pair ` snd ` set [d\<leftarrow>D. d \<notin> set Di]"
     by (metis "6.IH")
   moreover have "set [d\<leftarrow>D. d \<notin> set Di] \<subseteq> set D" using set_filter by auto
   ultimately have
       "trms\<^sub>l\<^sub>s\<^sub>t A'' \<subseteq> trms\<^sub>s\<^sub>s\<^sub>t (unlabel A) \<union> pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A) \<union> pair ` snd ` set D"
     by blast
   hence "trms\<^sub>l\<^sub>s\<^sub>t A'' \<subseteq> trms\<^sub>s\<^sub>s\<^sub>t (unlabel ((i,delete\<langle>t,s\<rangle>)#A)) \<union>
                         pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel ((i,delete\<langle>t,s\<rangle>)#A)) \<union>
                         pair ` snd ` set D"
     using setops\<^sub>s\<^sub>s\<^sub>t_cons_subset trms\<^sub>s\<^sub>s\<^sub>t_cons
     by (auto simp add: setops\<^sub>s\<^sub>s\<^sub>t_def)
   moreover have "set Di \<subseteq> set D" "set [d\<leftarrow>dbproj i D . d \<notin> set Di] \<subseteq> set D"
     using subseqs_set_subset[OF A''(1)] by auto
   hence "trms\<^sub>s\<^sub>t (unlabel B) \<subseteq> insert (pair (t, s)) (pair ` snd ` set D)"
         "trms\<^sub>s\<^sub>t (unlabel C) \<subseteq> insert (pair (t, s)) (pair ` snd ` set D)"
     using A''(4,5) unfolding unlabel_def by auto
   hence "trms\<^sub>s\<^sub>t (unlabel (B@C)) \<subseteq> insert (pair (t,s)) (pair ` snd ` set D)"
     using unlabel_append[of B C] by auto
   moreover have "pair (t,s) \<in> pair ` setops\<^sub>s\<^sub>s\<^sub>t (delete\<langle>t,s\<rangle>#unlabel A)" by (simp add: setops\<^sub>s\<^sub>s\<^sub>t_def)
   ultimately show ?case
     using A''(3) trms\<^sub>s\<^sub>t_append[of "unlabel (B@C)" "unlabel A'"] unlabel_append[of "B@C" A'']
     by (auto simp add: setops\<^sub>s\<^sub>s\<^sub>t_def)
 next
   case (7 i ac t s A D)
   from 7 obtain d A'' where A'':
       "d \<in> set (dbproj i D)" "A'' \<in> set (tr\<^sub>p\<^sub>c A D)"
       "A' = (i,\<langle>ac: (pair (t,s)) \<doteq> (pair (snd d))\<rangle>\<^sub>s\<^sub>t)#A''"
     by moura
   hence "trms\<^sub>l\<^sub>s\<^sub>t A'' \<subseteq> trms\<^sub>s\<^sub>s\<^sub>t (unlabel A) \<union> pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A) \<union>
                        pair ` snd ` set D"
     by (metis "7.IH")
   moreover have "trms\<^sub>s\<^sub>t (unlabel A') = {pair (t,s), pair (snd d)} \<union> trms\<^sub>s\<^sub>t (unlabel A'')"
     using A''(1,3) by auto
   ultimately show ?case using A''(1) by (auto simp add: setops\<^sub>s\<^sub>s\<^sub>t_def)
 next
   case (8 i X F F' A D)
   define constr where "constr = map (\<lambda>G. (i,\<forall>X\<langle>\<or>\<noteq>: (F@G)\<rangle>\<^sub>s\<^sub>t)) (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' (map snd (dbproj i D)))"
   define B where "B \<equiv> \<Union>(trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s ` set (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' (map snd (dbproj i D))))"
 
   from 8 obtain A'' where A'':
       "A'' \<in> set (tr\<^sub>p\<^sub>c A D)" "A' = constr@A''"
     unfolding constr_def by moura
 
   have "trms\<^sub>s\<^sub>t (unlabel A'') \<subseteq> trms\<^sub>s\<^sub>s\<^sub>t (unlabel A) \<union> pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A) \<union> pair`snd`set D"
     by (metis A''(1) "8.IH")
   moreover have "trms\<^sub>s\<^sub>t (unlabel constr) \<subseteq> B \<union> trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \<union> pair ` snd ` set D"
     unfolding unlabel_def constr_def B_def by auto
   ultimately have "trms\<^sub>s\<^sub>t (unlabel A') \<subseteq> B \<union> trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \<union> trms\<^sub>s\<^sub>s\<^sub>t (unlabel A) \<union>
                                          pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A) \<union> pair ` snd ` set D"
     using A'' unlabel_append[of constr A''] by auto
   moreover have "set (dbproj i D) \<subseteq> set D" by auto
   hence "B \<subseteq> pair ` set F' \<union> pair ` snd ` set D"
     using tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_trms_subset'[of F' "map snd (dbproj i D)"]
     unfolding B_def by force
   moreover have
       "pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel ((i, \<forall>X\<langle>\<or>\<noteq>: F \<or>\<notin>: F'\<rangle>)#A)) =
        pair ` set F' \<union> pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A)"
     by auto
   ultimately show ?case by (auto simp add: setops\<^sub>s\<^sub>s\<^sub>t_def)
 qed
 
 lemma tr_par_wf_trms:
   assumes "A' \<in> set (tr\<^sub>p\<^sub>c A [])" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>s\<^sub>t (unlabel A))"
   shows "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>t A')"
 using tr_par_trms_subset[OF assms(1)] setops\<^sub>s\<^sub>s\<^sub>t_wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s(2)[OF assms(2)]
 by auto
 
 lemma tr_par_wf':
   assumes "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel D) \<inter> bvars\<^sub>s\<^sub>s\<^sub>t (unlabel A) = {}"
   and "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel D) \<subseteq> X"
   and "wf'\<^sub>s\<^sub>s\<^sub>t X (unlabel A)" "fv\<^sub>s\<^sub>s\<^sub>t (unlabel A) \<inter> bvars\<^sub>s\<^sub>s\<^sub>t (unlabel A) = {}"
   and "A' \<in> set (tr\<^sub>p\<^sub>c A D)"
   shows "wf\<^sub>l\<^sub>s\<^sub>t X A'"
 proof -
   define P where
     "P = (\<lambda>(D::('fun,'var,'lbl) labeleddbstatelist) (A::('fun,'var,'lbl) labeled_stateful_strand).
           (fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel D) \<inter> bvars\<^sub>s\<^sub>s\<^sub>t (unlabel A) = {}) \<and>
           fv\<^sub>s\<^sub>s\<^sub>t (unlabel A) \<inter> bvars\<^sub>s\<^sub>s\<^sub>t (unlabel A) = {})"
 
   have "P D A" using assms(1,4) by (simp add: P_def)
   with assms(5,3,2) show ?thesis
   proof (induction A arbitrary: X A' D)
     case Nil thus ?case by simp
   next
     case (Cons a A)
     obtain i s where i: "a = (i,s)" by (metis surj_pair)
     note prems = Cons.prems
     note IH = Cons.IH
     show ?case
     proof (cases s)
       case (Receive t)
       note si = Receive i
       then obtain A'' where A'': "A' = (i,receive\<langle>t\<rangle>\<^sub>s\<^sub>t)#A''" "A'' \<in> set (tr\<^sub>p\<^sub>c A D)" "fv t \<subseteq> X"
         using prems unlabel_Cons(1)[of i s A] by moura
       have *: "wf'\<^sub>s\<^sub>s\<^sub>t X (unlabel A)"
               "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel D) \<subseteq> X"
               "P D A"
         using prems si apply (force, force)
         using prems(4) si unfolding P_def by fastforce
       show ?thesis using IH[OF A''(2) *] A''(1,3) by simp
     next
       case (Send t)
       note si = Send i
       then obtain A'' where A'': "A' = (i,send\<langle>t\<rangle>\<^sub>s\<^sub>t)#A''" "A'' \<in> set (tr\<^sub>p\<^sub>c A D)"
         using prems by moura
       have *: "wf'\<^sub>s\<^sub>s\<^sub>t (X \<union> fv t) (unlabel A)"
               "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel D) \<subseteq> X \<union> fv t"
               "P D A"
         using prems si apply (force, force)
         using prems(4) si unfolding P_def by fastforce
       show ?thesis using IH[OF A''(2) *] A''(1) by simp
     next
       case (Equality ac t t')
       note si = Equality i
       then obtain A'' where A'':
           "A' = (i,\<langle>ac: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t)#A''" "A'' \<in> set (tr\<^sub>p\<^sub>c A D)"
           "ac = Assign \<Longrightarrow> fv t' \<subseteq> X"
         using prems unlabel_Cons(1)[of i s] by moura
       have *: "ac = Assign \<Longrightarrow> wf'\<^sub>s\<^sub>s\<^sub>t (X \<union> fv t) (unlabel A)"
               "ac = Check \<Longrightarrow> wf'\<^sub>s\<^sub>s\<^sub>t X (unlabel A)"
               "ac = Assign \<Longrightarrow> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel D) \<subseteq> X \<union> fv t"
               "ac = Check \<Longrightarrow> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel D) \<subseteq> X"
               "P D A"
         using prems si apply (force, force, force, force)
         using prems(4) si unfolding P_def by fastforce
       show ?thesis
         using IH[OF A''(2) *(1,3,5)] IH[OF A''(2) *(2,4,5)] A''(1,3)
         by (cases ac) simp_all
     next
       case (Insert t t')
       note si = Insert i
       hence A': "A' \<in> set (tr\<^sub>p\<^sub>c A (List.insert (i,t,t') D))" "fv t \<subseteq> X" "fv t' \<subseteq> X"
         using prems by auto
       have *: "wf'\<^sub>s\<^sub>s\<^sub>t X (unlabel A)" "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel (List.insert (i,t,t') D)) \<subseteq> X"
         using prems si by (auto simp add: unlabel_def)
       have **: "P (List.insert (i,t,t') D) A"
         using prems(4) si
         unfolding P_def unlabel_def
         by fastforce
       show ?thesis using IH[OF A'(1) * **] A'(2,3) by simp
     next
       case (Delete t t')
       note si = Delete i
       define constr where "constr = (\<lambda>Di.
         (map (\<lambda>d. (i,\<langle>check: (pair (t,t')) \<doteq> (pair (snd d))\<rangle>\<^sub>s\<^sub>t)) Di)@
         (map (\<lambda>d. (i,\<forall>[]\<langle>\<or>\<noteq>: [(pair (t,t'), pair (snd d))]\<rangle>\<^sub>s\<^sub>t)) [d\<leftarrow>dbproj i D. d \<notin> set Di]))"
       from prems si obtain Di A'' where A'':
           "A' = constr Di@A''" "A'' \<in> set (tr\<^sub>p\<^sub>c A [d\<leftarrow>D. d \<notin> set Di])"
           "Di \<in> set (subseqs (dbproj i D))"
         unfolding constr_def by auto
       have *: "wf'\<^sub>s\<^sub>s\<^sub>t X (unlabel A)"
               "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel (filter (\<lambda>d. d \<notin> set Di) D)) \<subseteq> X"
         using prems si apply simp
         using prems si by (fastforce simp add: unlabel_def)
 
       have "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel (filter (\<lambda>d. d \<notin> set Di) D)) \<subseteq> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel D)"
         by (auto simp add: unlabel_def)
       hence **: "P [d\<leftarrow>D. d \<notin> set Di] A"
         using prems si unfolding P_def
         by fastforce
 
       have ***: "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel D) \<subseteq> X" using prems si by auto
       show ?thesis
         using IH[OF A''(2) * **] A''(1) wf_pair_eqs_ineqs_map'[OF _ A''(3) ***]
         unfolding constr_def by simp
     next
       case (InSet ac t t')
       note si = InSet i
       then obtain d A'' where A'':
           "A' = (i,\<langle>ac: (pair (t,t')) \<doteq> (pair (snd d))\<rangle>\<^sub>s\<^sub>t)#A''"
           "A'' \<in> set (tr\<^sub>p\<^sub>c A D)"
           "d \<in> set D"
         using prems by moura
       have *:
           "ac = Assign \<Longrightarrow> wf'\<^sub>s\<^sub>s\<^sub>t (X \<union> fv t \<union> fv t') (unlabel A)"
           "ac = Check \<Longrightarrow> wf'\<^sub>s\<^sub>s\<^sub>t X (unlabel A)"
           "ac = Assign \<Longrightarrow> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel D) \<subseteq> X \<union> fv t \<union> fv t'"
           "ac = Check \<Longrightarrow> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel D) \<subseteq> X"
           "P D A"
         using prems si apply (force, force, force, force)
         using prems(4) si unfolding P_def by fastforce
       have **: "fv (pair (snd d)) \<subseteq> X"
         using A''(3) prems(3) fv_pair_fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_subset
         by fast
       have ***: "fv (pair (t,t')) = fv t \<union> fv t'" unfolding pair_def by auto
       show ?thesis
         using IH[OF A''(2) *(1,3,5)] IH[OF A''(2) *(2,4,5)] A''(1) ** ***
         by (cases ac) (simp_all add: Un_assoc)
     next
       case (NegChecks Y F F')
       note si = NegChecks i
       then obtain A'' where A'':
           "A' = (map (\<lambda>G. (i,\<forall>Y\<langle>\<or>\<noteq>: (F@G)\<rangle>\<^sub>s\<^sub>t)) (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' (map snd (dbproj i D))))@A''"
           "A'' \<in> set (tr\<^sub>p\<^sub>c A D)"
         using prems by moura
 
       have *: "wf'\<^sub>s\<^sub>s\<^sub>t X (unlabel A)" "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel D) \<subseteq> X" using prems si by auto
-      
+
       have "bvars\<^sub>s\<^sub>s\<^sub>t (unlabel A) \<subseteq> bvars\<^sub>s\<^sub>s\<^sub>t (unlabel ((i,\<forall>Y\<langle>\<or>\<noteq>: F \<or>\<notin>: F'\<rangle>)#A))"
            "fv\<^sub>s\<^sub>s\<^sub>t (unlabel A) \<subseteq> fv\<^sub>s\<^sub>s\<^sub>t (unlabel ((i,\<forall>Y\<langle>\<or>\<noteq>: F \<or>\<notin>: F'\<rangle>)#A))"
         by auto
       hence **:  "P D A" using prems si unfolding P_def by blast
-  
+
       show ?thesis using IH[OF A''(2) * **] A''(1) wf_pair_negchecks_map' by simp
     qed
   qed
 qed
 
 lemma tr_par_wf:
   assumes "A' \<in> set (tr\<^sub>p\<^sub>c A [])"
     and "wf\<^sub>s\<^sub>s\<^sub>t (unlabel A)"
     and "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A)"
   shows "wf\<^sub>l\<^sub>s\<^sub>t {} A'"
     and "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>t A')"
     and "fv\<^sub>l\<^sub>s\<^sub>t A' \<inter> bvars\<^sub>l\<^sub>s\<^sub>t A' = {}"
 using tr_par_wf'[OF _ _ _ _ assms(1)]
       tr_par_wf_trms[OF assms(1,3)]
       tr_par_vars_disj[OF assms(1)]
       assms(2)
 by fastforce+
 
 lemma tr_par_tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p:
   assumes "A' \<in> set (tr\<^sub>p\<^sub>c A D)" "list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (unlabel A)"
   and "fv\<^sub>s\<^sub>s\<^sub>t (unlabel A) \<inter> bvars\<^sub>s\<^sub>s\<^sub>t (unlabel A) = {}" (is "?P0 A D")
   and "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel D) \<inter> bvars\<^sub>s\<^sub>s\<^sub>t (unlabel A) = {}" (is "?P1 A D")
   and "\<forall>t \<in> pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A) \<union> pair ` snd ` set D.
        \<forall>t' \<in> pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A) \<union> pair ` snd ` set D.
           (\<exists>\<delta>. Unifier \<delta> t t') \<longrightarrow> \<Gamma> t = \<Gamma> t'" (is "?P3 A D")
   shows "list_all tfr\<^sub>s\<^sub>t\<^sub>p (unlabel A')"
 proof -
   have sublmm: "list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (unlabel A)" "?P0 A D" "?P1 A D" "?P3 A D"
     when p: "list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (unlabel (a#A))" "?P0 (a#A) D" "?P1 (a#A) D" "?P3 (a#A) D"
     for a A D
   proof -
     show "list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (unlabel A)" using p(1) by (simp add: unlabel_def tfr\<^sub>s\<^sub>s\<^sub>t_def)
     show "?P0 A D" using p(2) fv\<^sub>s\<^sub>s\<^sub>t_cons_subset unfolding unlabel_def by fastforce
     show "?P1 A D" using p(3) bvars\<^sub>s\<^sub>s\<^sub>t_cons_subset unfolding unlabel_def by fastforce
     have "setops\<^sub>s\<^sub>s\<^sub>t (unlabel A) \<subseteq> setops\<^sub>s\<^sub>s\<^sub>t (unlabel (a#A))"
       using setops\<^sub>s\<^sub>s\<^sub>t_cons_subset unfolding unlabel_def by auto
     thus "?P3 A D" using p(4) by blast
   qed
 
   show ?thesis using assms
   proof (induction A D arbitrary: A' rule: tr\<^sub>p\<^sub>c.induct)
     case 1 thus ?case by simp
   next
     case (2 i t A D)
     note prems = "2.prems"
     note IH = "2.IH"
     from prems(1) obtain A'' where A'': "A' = (i,send\<langle>t\<rangle>\<^sub>s\<^sub>t)#A''" "A'' \<in> set (tr\<^sub>p\<^sub>c A D)" by moura
     have "list_all tfr\<^sub>s\<^sub>t\<^sub>p (unlabel A'')"
       using IH[OF A''(2)] prems(5) sublmm[OF prems(2,3,4,5)]
       by meson
     thus ?case using A''(1) by simp
   next
     case (3 i t A D)
     note prems = "3.prems"
     note IH = "3.IH"
     from prems(1) obtain A'' where A'': "A' = (i,receive\<langle>t\<rangle>\<^sub>s\<^sub>t)#A''" "A'' \<in> set (tr\<^sub>p\<^sub>c A D)" by moura
     have "list_all tfr\<^sub>s\<^sub>t\<^sub>p (unlabel A'')"
       using IH[OF A''(2)] prems(5) sublmm[OF prems(2,3,4,5)]
       by meson
     thus ?case using A''(1) by simp
   next
     case (4 i ac t t' A D)
     note prems = "4.prems"
     note IH = "4.IH"
     from prems(1) obtain A'' where A'': "A' = (i,\<langle>ac: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t)#A''" "A'' \<in> set (tr\<^sub>p\<^sub>c A D)" by moura
     have "list_all tfr\<^sub>s\<^sub>t\<^sub>p (unlabel A'')"
       using IH[OF A''(2)] prems(5) sublmm[OF prems(2,3,4,5)]
       by meson
     thus ?case using A''(1) prems(2) by simp
   next
     case (5 i t s A D)
     note prems = "5.prems"
     note IH = "5.IH"
     from prems(1) have A': "A' \<in> set (tr\<^sub>p\<^sub>c A (List.insert (i,t,s) D))" by simp
 
     have 1: "list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (unlabel A)" using sublmm[OF prems(2,3,4,5)] by simp
-  
+
     have "pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel ((i,insert\<langle>t,s\<rangle>)#A)) \<union> pair`snd`set D =
           pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A) \<union> pair`snd`set (List.insert (i,t,s) D)"
       by (auto simp add: setops\<^sub>s\<^sub>s\<^sub>t_def)
     hence 3: "?P3 A (List.insert (i,t,s) D)" using prems(5) by metis
     moreover have "?P1 A (List.insert (i,t,s) D)"
       using prems(3,4) bvars\<^sub>s\<^sub>s\<^sub>t_cons_subset[of "unlabel A" "insert\<langle>t,s\<rangle>"]
       unfolding unlabel_def
       by fastforce
     ultimately have "list_all tfr\<^sub>s\<^sub>t\<^sub>p (unlabel A')"
       using IH[OF A' sublmm(1,2)[OF prems(2,3,4,5)] _ 3] by metis
     thus ?case using A'(1) by auto
   next
     case (6 i t s A D)
     note prems = "6.prems"
     note IH = "6.IH"
 
     define constr where constr: "constr \<equiv> (\<lambda>Di.
       (map (\<lambda>d. (i,\<langle>check: (pair (t,s)) \<doteq> (pair (snd d))\<rangle>\<^sub>s\<^sub>t)) Di)@
       (map (\<lambda>d. (i,\<forall>[]\<langle>\<or>\<noteq>: [(pair (t,s), pair (snd d))]\<rangle>\<^sub>s\<^sub>t)) (filter (\<lambda>d. d \<notin> set Di) (dbproj i D))))"
 
     from prems(1) obtain Di A'' where A'':
         "A' = constr Di@A''" "A'' \<in> set (tr\<^sub>p\<^sub>c A (filter (\<lambda>d. d \<notin> set Di) D))"
         "Di \<in> set (subseqs (dbproj i D))"
       unfolding constr by fastforce
 
     define Q1 where "Q1 \<equiv> (\<lambda>(F::(('fun,'var) term \<times> ('fun,'var) term) list) X.
         \<forall>x \<in> (fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F) - set X. \<exists>a. \<Gamma> (Var x) = TAtom a)"
     define Q2 where "Q2 \<equiv> (\<lambda>(F::(('fun,'var) term \<times> ('fun,'var) term) list) X.
         \<forall>f T. Fun f T \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F) \<longrightarrow> T = [] \<or> (\<exists>s \<in> set T. s \<notin> Var ` set X))"
 
     have "pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A) \<union> pair`snd`set [d\<leftarrow>D. d \<notin> set Di]
             \<subseteq> pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel ((i,delete\<langle>t,s\<rangle>)#A)) \<union> pair`snd`set D"
       using subseqs_set_subset[OF A''(3)] by (force simp add: setops\<^sub>s\<^sub>s\<^sub>t_def)
     moreover have "\<forall>a\<in>M. \<forall>b\<in>M. P a b"
       when "M \<subseteq> N" "\<forall>a\<in>N. \<forall>b\<in>N. P a b"
       for M N::"('fun, 'var) terms" and  P
       using that by blast
     ultimately have *: "?P3 A (filter (\<lambda>d. d \<notin> set Di) D)"
       using prems(5) by presburger
 
     have **: "?P1 A (filter (\<lambda>d. d \<notin> set Di) D)"
       using prems(4) bvars\<^sub>s\<^sub>s\<^sub>t_cons_subset[of "unlabel A" "delete\<langle>t,s\<rangle>"]
       unfolding unlabel_def by fastforce
-      
+
     have 1: "list_all tfr\<^sub>s\<^sub>t\<^sub>p (unlabel A'')"
       using IH[OF A''(3,2) sublmm(1,2)[OF prems(2,3,4,5)] ** *]
       by metis
 
     have 2: "\<langle>ac: u \<doteq> u'\<rangle>\<^sub>s\<^sub>t \<in> set (unlabel A'') \<or>
              (\<exists>d \<in> set Di. u = pair (t,s) \<and> u' = pair (snd d))"
       when "\<langle>ac: u \<doteq> u'\<rangle>\<^sub>s\<^sub>t \<in> set (unlabel A')" for ac u u'
       using that A''(1) unfolding constr unlabel_def by force
     have 3:
         "\<forall>X\<langle>\<or>\<noteq>: u\<rangle>\<^sub>s\<^sub>t \<in> set (unlabel A'') \<or>
          (\<exists>d \<in> set (filter (\<lambda>d. d \<notin> set Di) D). u = [(pair (t,s), pair (snd d))] \<and> Q2 u X)"
       when "\<forall>X\<langle>\<or>\<noteq>: u\<rangle>\<^sub>s\<^sub>t \<in> set (unlabel A')" for X u
       using that A''(1) unfolding Q2_def constr unlabel_def by force
     have 4: "\<forall>d\<in>set D. (\<exists>\<delta>. Unifier \<delta> (pair (t,s)) (pair (snd d)))
                        \<longrightarrow> \<Gamma> (pair (t,s)) = \<Gamma> (pair (snd d))"
       using prems(5) by (simp add: setops\<^sub>s\<^sub>s\<^sub>t_def)
 
     { fix ac u u'
       assume a: "\<langle>ac: u \<doteq> u'\<rangle>\<^sub>s\<^sub>t \<in> set (unlabel A')" "\<exists>\<delta>. Unifier \<delta> u u'"
       hence "\<langle>ac: u \<doteq> u'\<rangle>\<^sub>s\<^sub>t \<in> set (unlabel A'') \<or> (\<exists>d \<in> set Di. u = pair (t,s) \<and> u' = pair (snd d))"
         using 2 by metis
       moreover {
         assume "\<langle>ac: u \<doteq> u'\<rangle>\<^sub>s\<^sub>t \<in> set (unlabel A'')"
         hence "tfr\<^sub>s\<^sub>t\<^sub>p (\<langle>ac: u \<doteq> u'\<rangle>\<^sub>s\<^sub>t)"
           using 1 Ball_set_list_all[of "unlabel A''" tfr\<^sub>s\<^sub>t\<^sub>p]
           by fast
       } moreover {
         fix d assume "d \<in> set Di" "u = pair (t,s)" "u' = pair (snd d)"
         hence "\<exists>\<delta>. Unifier \<delta> u u' \<Longrightarrow> \<Gamma> u = \<Gamma> u'"
           using 4 dbproj_subseq_subset A''(3)
           by fast
         hence "tfr\<^sub>s\<^sub>t\<^sub>p (\<langle>ac: u \<doteq> u'\<rangle>\<^sub>s\<^sub>t)"
           using Ball_set_list_all[of "unlabel A''" tfr\<^sub>s\<^sub>t\<^sub>p]
           by simp
         hence "\<Gamma> u = \<Gamma> u'" using tfr\<^sub>s\<^sub>t\<^sub>p_list_all_alt_def[of "unlabel A''"]
           using a(2) unfolding unlabel_def by auto
       } ultimately have "\<Gamma> u = \<Gamma> u'"
           using tfr\<^sub>s\<^sub>t\<^sub>p_list_all_alt_def[of "unlabel A''"] a(2)
           unfolding unlabel_def by auto
     } moreover {
       fix u U
       assume "\<forall>U\<langle>\<or>\<noteq>: u\<rangle>\<^sub>s\<^sub>t \<in> set (unlabel A')"
       hence "\<forall>U\<langle>\<or>\<noteq>: u\<rangle>\<^sub>s\<^sub>t \<in> set (unlabel A'') \<or>
              (\<exists>d \<in> set (filter (\<lambda>d. d \<notin> set Di) D). u = [(pair (t,s), pair (snd d))] \<and> Q2 u U)"
         using 3 by metis
       hence "Q1 u U \<or> Q2 u U"
         using 1 4 subseqs_set_subset[OF A''(3)] tfr\<^sub>s\<^sub>t\<^sub>p_list_all_alt_def[of "unlabel A''"]
         unfolding Q1_def Q2_def
         by blast
     } ultimately show ?case
       using tfr\<^sub>s\<^sub>t\<^sub>p_list_all_alt_def[of "unlabel A'"] unfolding Q1_def Q2_def unlabel_def by blast
   next
     case (7 i ac t s A D)
     note prems = "7.prems"
     note IH = "7.IH"
 
     from prems(1) obtain d A'' where A'':
         "A' = (i,\<langle>ac: (pair (t,s)) \<doteq> (pair (snd d))\<rangle>\<^sub>s\<^sub>t)#A''"
         "A'' \<in> set (tr\<^sub>p\<^sub>c A D)"
         "d \<in> set (dbproj i D)"
       by moura
 
     have 1: "list_all tfr\<^sub>s\<^sub>t\<^sub>p (unlabel A'')"
-      using IH[OF A''(2) sublmm(1,2,3)[OF prems(2,3,4,5)] sublmm(4)[OF prems(2,3,4,5)]] 
+      using IH[OF A''(2) sublmm(1,2,3)[OF prems(2,3,4,5)] sublmm(4)[OF prems(2,3,4,5)]]
       by metis
-    
+
     have 2: "\<Gamma> (pair (t,s)) = \<Gamma> (pair (snd d))"
       when "\<exists>\<delta>. Unifier \<delta> (pair (t,s)) (pair (snd d))"
       using that prems(2,5) A''(3) unfolding tfr\<^sub>s\<^sub>s\<^sub>t_def by (simp add: setops\<^sub>s\<^sub>s\<^sub>t_def)
-    
+
     show ?case using A''(1) 1 2 by fastforce
   next
     case (8 i X F F' A D)
     note prems = "8.prems"
     note IH = "8.IH"
 
     define constr where
       "constr = map (\<lambda>G. (i,\<forall>X\<langle>\<or>\<noteq>: (F@G)\<rangle>\<^sub>s\<^sub>t)) (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' (map snd (dbproj i D)))"
 
     define Q1 where "Q1 \<equiv> (\<lambda>(F::(('fun,'var) term \<times> ('fun,'var) term) list) X.
         \<forall>x \<in> (fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F) - set X. \<exists>a. \<Gamma> (Var x) = TAtom a)"
 
     define Q2 where "Q2 \<equiv> (\<lambda>(M::('fun,'var) terms) X.
         \<forall>f T. Fun f T \<in> subterms\<^sub>s\<^sub>e\<^sub>t M \<longrightarrow> T = [] \<or> (\<exists>s \<in> set T. s \<notin> Var ` set X))"
 
     have Q2_subset: "Q2 M' X" when "M' \<subseteq> M" "Q2 M X" for X M M'
       using that unfolding Q2_def by auto
 
     have Q2_supset: "Q2 (M \<union> M') X" when "Q2 M X" "Q2 M' X" for X M M'
       using that unfolding Q2_def by auto
 
     from prems obtain A'' where A'': "A' = constr@A''" "A'' \<in> set (tr\<^sub>p\<^sub>c A D)"
       using constr_def by moura
 
     have 0: "constr = [(i,\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t)]" when "F' = []" using that unfolding constr_def by simp
 
     have 1: "list_all tfr\<^sub>s\<^sub>t\<^sub>p (unlabel A'')"
       using IH[OF A''(2) sublmm(1,2,3)[OF prems(2,3,4,5)] sublmm(4)[OF prems(2,3,4,5)]]
       by metis
 
     have 2: "(F' = [] \<and> Q1 F X) \<or> Q2 (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \<union> pair ` set F') X"
       using prems(2) unfolding Q1_def Q2_def by simp
-  
+
     have 3: "F' = [] \<Longrightarrow> Q1 F X \<Longrightarrow> list_all tfr\<^sub>s\<^sub>t\<^sub>p (unlabel constr)"
       using 0 2 tfr\<^sub>s\<^sub>t\<^sub>p_list_all_alt_def[of "unlabel constr"] unfolding Q1_def by auto
 
     { fix c assume "c \<in> set (unlabel constr)"
       hence "\<exists>G \<in> set (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' (map snd (dbproj i D))). c = \<forall>X\<langle>\<or>\<noteq>: (F@G)\<rangle>\<^sub>s\<^sub>t"
         unfolding constr_def unlabel_def by force
     } moreover {
       fix G
       assume G: "G \<in> set (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' (map snd (dbproj i D)))"
          and c: "\<forall>X\<langle>\<or>\<noteq>: (F@G)\<rangle>\<^sub>s\<^sub>t \<in> set (unlabel constr)"
          and e: "Q2 (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \<union> pair ` set F') X"
 
       have d_Q2: "Q2 (pair ` set (map snd D)) X" unfolding Q2_def
       proof (intro allI impI)
         fix f T assume "Fun f T \<in> subterms\<^sub>s\<^sub>e\<^sub>t (pair ` set (map snd D))"
         then obtain d where d: "d \<in> set (map snd D)" "Fun f T \<in> subterms (pair d)" by force
         hence "fv (pair d) \<inter> set X = {}"
           using prems(4) unfolding pair_def by (force simp add: unlabel_def)
         thus "T = [] \<or> (\<exists>s \<in> set T. s \<notin> Var ` set X)"
           by (metis fv_disj_Fun_subterm_param_cases d(2))
       qed
 
       have "trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F@G) \<subseteq> trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \<union> pair ` set F' \<union> pair ` set (map snd D)"
         using tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_trms_subset[OF G] by force
       hence "Q2 (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F@G)) X" using Q2_subset[OF _ Q2_supset[OF e d_Q2]] by metis
       hence "tfr\<^sub>s\<^sub>t\<^sub>p (\<forall>X\<langle>\<or>\<noteq>: (F@G)\<rangle>\<^sub>s\<^sub>t)" by (metis Q2_def tfr\<^sub>s\<^sub>t\<^sub>p.simps(2))
     } ultimately have 4:
         "Q2 (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \<union> pair ` set F') X \<Longrightarrow> list_all tfr\<^sub>s\<^sub>t\<^sub>p (unlabel constr)"
       using Ball_set by blast
 
     have 5: "list_all tfr\<^sub>s\<^sub>t\<^sub>p (unlabel constr)" using 2 3 4 by metis
 
     show ?case using 1 5 A''(1) by (simp add: unlabel_def)
   qed
 qed
 
 lemma tr_par_tfr:
   assumes "A' \<in> set (tr\<^sub>p\<^sub>c A [])" and "tfr\<^sub>s\<^sub>s\<^sub>t (unlabel A)"
     and "fv\<^sub>s\<^sub>s\<^sub>t (unlabel A) \<inter> bvars\<^sub>s\<^sub>s\<^sub>t (unlabel A) = {}"
   shows "tfr\<^sub>s\<^sub>t (unlabel A')"
 proof -
   have *: "trms\<^sub>l\<^sub>s\<^sub>t A' \<subseteq> trms\<^sub>s\<^sub>s\<^sub>t (unlabel A) \<union> pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A)"
     using tr_par_trms_subset[OF assms(1)] by simp
   hence "SMP (trms\<^sub>l\<^sub>s\<^sub>t A') \<subseteq> SMP (trms\<^sub>s\<^sub>s\<^sub>t (unlabel A) \<union> pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A))"
     using SMP_mono by simp
   moreover have "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>s\<^sub>t (unlabel A) \<union> pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A))"
     using assms(2) unfolding tfr\<^sub>s\<^sub>s\<^sub>t_def by fast
   ultimately have 1: "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>t A')" by (metis tfr_subset(2)[OF _ *])
 
   have **: "list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (unlabel A)" using assms(2) unfolding tfr\<^sub>s\<^sub>s\<^sub>t_def by fast
   have "pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A) \<subseteq>
         SMP (trms\<^sub>s\<^sub>s\<^sub>t (unlabel A) \<union> pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A)) - Var`\<V>"
     using setops\<^sub>s\<^sub>s\<^sub>t_are_pairs unfolding pair_def by auto
   hence "\<Gamma> t = \<Gamma> t'"
     when "\<exists>\<delta>. Unifier \<delta> t t'" "t \<in> pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A)" "t' \<in> pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A)"
     for t t'
     using that assms(2) unfolding tfr\<^sub>s\<^sub>s\<^sub>t_def tfr\<^sub>s\<^sub>e\<^sub>t_def by blast
   moreover have "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (unlabel []) = {}" "pair ` snd ` set [] = {}" by auto
   ultimately have 2: "list_all tfr\<^sub>s\<^sub>t\<^sub>p (unlabel A')"
     using tr_par_tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p[OF assms(1) ** assms(3)] by simp
 
   show ?thesis by (metis 1 2 tfr\<^sub>s\<^sub>t_def)
 qed
 
 lemma tr_par_proj:
   assumes "B \<in> set (tr\<^sub>p\<^sub>c A D)"
   shows "proj n B \<in> set (tr\<^sub>p\<^sub>c (proj n A) (proj n D))"
 using assms
 proof (induction A D arbitrary: B rule: tr\<^sub>p\<^sub>c.induct)
   case (5 i t s S D)
   note prems = "5.prems"
   note IH = "5.IH"
   have IH': "proj n B \<in> set (tr\<^sub>p\<^sub>c (proj n S) (proj n (List.insert (i,t,s) D)))"
     using prems IH by auto
   show ?case
   proof (cases "(i = ln n) \<or> (i = \<star>)")
     case True thus ?thesis
       using IH' proj_list_insert(1,2)[of n "(t,s)" D] proj_list_Cons(1,2)[of n _ S]
       by auto
   next
     case False
     then obtain m where "i = ln m" "n \<noteq> m" by (cases i) simp_all
     thus ?thesis
       using IH' proj_list_insert(3)[of n _ "(t,s)" D] proj_list_Cons(3)[of n _ "insert\<langle>t,s\<rangle>" S]
       by auto
   qed
 next
   case (6 i t s S D)
   note prems = "6.prems"
   note IH = "6.IH"
   define constr where "constr = (\<lambda>Di D.
       (map (\<lambda>d. (i,\<langle>check: (pair (t,s)) \<doteq> (pair (snd d))\<rangle>\<^sub>s\<^sub>t)) Di)@
       (map (\<lambda>d. (i,\<forall>[]\<langle>\<or>\<noteq>: [(pair (t,s), pair (snd d))]\<rangle>\<^sub>s\<^sub>t)) [d\<leftarrow>dbproj i D. d \<notin> set Di]))"
 
   obtain Di B' where B':
       "B = constr Di D@B'"
       "Di \<in> set (subseqs (dbproj i D))"
       "B' \<in> set (tr\<^sub>p\<^sub>c S [d\<leftarrow>D. d \<notin> set Di])"
     using prems constr_def by fastforce
   hence "proj n B' \<in> set (tr\<^sub>p\<^sub>c (proj n S) (proj n [d\<leftarrow>D. d \<notin> set Di]))" using IH by simp
   hence IH': "proj n B' \<in> set (tr\<^sub>p\<^sub>c (proj n S) [d\<leftarrow>proj n D. d \<notin> set Di])" by (metis proj_filter)
   show ?case
   proof (cases "(i = ln n) \<or> (i = \<star>)")
     case True
     hence "proj n B = constr Di D@proj n B'" "Di \<in> set (subseqs (dbproj i (proj n D)))"
       using B'(1,2) proj_dbproj(1,2)[of n D] unfolding proj_def constr_def by auto
     moreover have "constr Di (proj n D) = constr Di D"
       using True proj_dbproj(1,2)[of n D] unfolding constr_def by presburger
     ultimately have "proj n B \<in> set (tr\<^sub>p\<^sub>c ((i, delete\<langle>t,s\<rangle>)#proj n S) (proj n D))"
       using IH' unfolding constr_def by force
     thus ?thesis by (metis proj_list_Cons(1,2) True)
   next
     case False
     then obtain m where m: "i = ln m" "n \<noteq> m" by (cases i) simp_all
     hence *: "(ln n) \<noteq> i" by simp
     have "proj n B = proj n B'" using B'(1) False unfolding constr_def proj_def by auto
     moreover have "[d\<leftarrow>proj n D. d \<notin> set Di] = proj n D"
       using proj_subseq[OF _ m(2)[symmetric]] m(1) B'(2) by simp
     ultimately show ?thesis using m(1) IH' proj_list_Cons(3)[OF m(2), of _ S] by auto
   qed
 next
   case (7 i ac t s S D)
   note prems = "7.prems"
   note IH = "7.IH"
   define constr where "constr = (
     \<lambda>d::'lbl strand_label \<times> ('fun,'var) term \<times> ('fun,'var) term.
       (i,\<langle>ac: (pair (t,s)) \<doteq> (pair (snd d))\<rangle>\<^sub>s\<^sub>t))"
 
   obtain d B' where B':
       "B = constr d#B'"
       "d \<in> set (dbproj i D)"
       "B' \<in> set (tr\<^sub>p\<^sub>c S D)"
     using prems constr_def by fastforce
   hence IH': "proj n B' \<in> set (tr\<^sub>p\<^sub>c (proj n S) (proj n D))" using IH by auto
 
   show ?case
   proof (cases "(i = ln n) \<or> (i = \<star>)")
     case True
     hence "proj n B = constr d#proj n B'" "d \<in> set (dbproj i (proj n D))"
       using B' proj_list_Cons(1,2)[of n _ B']
       unfolding constr_def
       by (force, metis proj_dbproj(1,2))
     hence "proj n B \<in> set (tr\<^sub>p\<^sub>c ((i, InSet ac t s)#proj n S) (proj n D))"
       using IH' unfolding constr_def by auto
     thus ?thesis using proj_list_Cons(1,2)[of n _ S] True by metis
   next
     case False
     then obtain m where m: "i = ln m" "n \<noteq> m" by (cases i) simp_all
     hence "proj n B = proj n B'" using B'(1) proj_list_Cons(3) unfolding constr_def by auto
     thus ?thesis
       using IH' m proj_list_Cons(3)[OF m(2), of "InSet ac t s" S]
       unfolding constr_def
       by auto
   qed
 next
   case (8 i X F F' S D)
   note prems = "8.prems"
   note IH = "8.IH"
 
   define constr where
     "constr = (\<lambda>D. map (\<lambda>G. (i,\<forall>X\<langle>\<or>\<noteq>: (F@G)\<rangle>\<^sub>s\<^sub>t)) (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' (map snd (dbproj i D))))"
-  
+
   obtain B' where B':
       "B = constr D@B'"
       "B' \<in> set (tr\<^sub>p\<^sub>c S D)"
     using prems constr_def by fastforce
   hence IH': "proj n B' \<in> set (tr\<^sub>p\<^sub>c (proj n S) (proj n D))" using IH by auto
 
   show ?case
   proof (cases "(i = ln n) \<or> (i = \<star>)")
     case True
     hence "proj n B = constr (proj n D)@proj n B'"
       using B'(1,2) proj_dbproj(1,2)[of n D] unfolding proj_def constr_def by auto
     hence "proj n B \<in> set (tr\<^sub>p\<^sub>c ((i, NegChecks X F F')#proj n S) (proj n D))"
       using IH' unfolding constr_def by auto
     thus ?thesis using proj_list_Cons(1,2)[of n _ S] True by metis
   next
     case False
     then obtain m where m: "i = ln m" "n \<noteq> m" by (cases i) simp_all
     hence "proj n B = proj n B'" using B'(1) unfolding constr_def proj_def by auto
     thus ?thesis
       using IH' m proj_list_Cons(3)[OF m(2), of "NegChecks X F F'" S]
       unfolding constr_def
       by auto
   qed
 qed (force simp add: proj_def)+
 
 lemma tr_par_preserves_typing_cond:
   assumes "par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t A Sec" "typing_cond\<^sub>s\<^sub>s\<^sub>t (unlabel A)" "A' \<in> set (tr\<^sub>p\<^sub>c A [])"
   shows "typing_cond (unlabel A')"
 proof -
   have "wf'\<^sub>s\<^sub>s\<^sub>t {} (unlabel A)"
        "fv\<^sub>s\<^sub>s\<^sub>t (unlabel A) \<inter> bvars\<^sub>s\<^sub>s\<^sub>t (unlabel A) = {}"
        "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>s\<^sub>t (unlabel A))"
     using assms(2) unfolding typing_cond\<^sub>s\<^sub>s\<^sub>t_def by simp_all
   hence 1: "wf\<^sub>s\<^sub>t {} (unlabel A')"
            "fv\<^sub>s\<^sub>t (unlabel A') \<inter> bvars\<^sub>s\<^sub>t (unlabel A') = {}"
            "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t (unlabel A'))"
            "Ana_invar_subst (ik\<^sub>s\<^sub>t (unlabel A') \<union> assignment_rhs\<^sub>s\<^sub>t (unlabel A'))"
     using tr_par_wf[OF assms(3)] Ana_invar_subst' by metis+
 
   have 2: "tfr\<^sub>s\<^sub>t (unlabel A')" by (metis tr_par_tfr assms(2,3) typing_cond\<^sub>s\<^sub>s\<^sub>t_def)
 
   show ?thesis by (metis 1 2 typing_cond_def)
 qed
 
 lemma tr_par_preserves_par_comp:
   assumes "par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t A Sec" "A' \<in> set (tr\<^sub>p\<^sub>c A [])"
   shows "par_comp A' Sec"
 proof -
   let ?M = "\<lambda>l. trms\<^sub>s\<^sub>s\<^sub>t (proj_unl l A) \<union> pair ` setops\<^sub>s\<^sub>s\<^sub>t (proj_unl l A)"
   let ?N = "\<lambda>l. trms_proj\<^sub>l\<^sub>s\<^sub>t l A'"
 
   have 0: "\<forall>l1 l2. l1 \<noteq> l2 \<longrightarrow> GSMP_disjoint (?M l1) (?M l2) Sec"
     using assms(1) unfolding par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by simp_all
 
   { fix l1 l2::'lbl assume *: "l1 \<noteq> l2"
     hence "GSMP_disjoint (?M l1) (?M l2) Sec" using 0(1) by metis
     moreover have "pair ` snd ` set (proj n []) = {}" for n::'lbl unfolding proj_def by simp
     hence "?N l1 \<subseteq> ?M l1" "?N l2 \<subseteq> ?M l2"
       using tr_par_trms_subset[OF tr_par_proj[OF assms(2)]] by (metis Un_empty_right)+
     ultimately have "GSMP_disjoint (?N l1) (?N l2) Sec"
       using GSMP_disjoint_subset by presburger
   } hence 1: "\<forall>l1 l2. l1 \<noteq> l2 \<longrightarrow> GSMP_disjoint (trms_proj\<^sub>l\<^sub>s\<^sub>t l1 A') (trms_proj\<^sub>l\<^sub>s\<^sub>t l2 A') Sec"
     using 0(1) by metis
 
   have 2: "ground Sec" "\<forall>s \<in> Sec. \<forall>s' \<in> subterms s. {} \<turnstile>\<^sub>c s' \<or> s' \<in> Sec"
     using assms(1) unfolding par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by metis+
 
   show ?thesis using 1 2 unfolding par_comp_def by metis
 qed
 
 lemma tr_leaking_prefix_exists:
   assumes "A' \<in> set (tr\<^sub>p\<^sub>c A [])" "prefix B A'" "ik\<^sub>s\<^sub>t (proj_unl n B) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> t \<cdot> \<I>"
   shows "\<exists>C D. prefix C B \<and> prefix D A \<and> C \<in> set (tr\<^sub>p\<^sub>c D []) \<and> (ik\<^sub>s\<^sub>t (proj_unl n C) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> t \<cdot> \<I>)"
 proof -
   let ?P = "\<lambda>B C C'. B = C@C' \<and> (\<forall>n t. (n, receive\<langle>t\<rangle>\<^sub>s\<^sub>t) \<notin> set C') \<and>
                      (C = [] \<or> (\<exists>n t. suffix [(n,receive\<langle>t\<rangle>\<^sub>s\<^sub>t)] C))"
   have "\<exists>C C'. ?P B C C'"
   proof (induction B)
     case (Cons b B)
     then obtain C C' n s where *: "?P B C C'" "b = (n,s)" by moura
     show ?case
     proof (cases "C = []")
       case True
       note T = True
       show ?thesis
       proof (cases "\<exists>t. s = receive\<langle>t\<rangle>\<^sub>s\<^sub>t")
         case True
         hence "?P (b#B) [b] C'" using * T  by auto
         thus ?thesis by metis
       next
         case False
         hence "?P (b#B) [] (b#C')" using * T by auto
         thus ?thesis by metis
       qed
     next
       case False
       hence "?P (b#B) (b#C) C'" using * unfolding suffix_def by auto
       thus ?thesis by metis
     qed
   qed simp
   then obtain C C' where C:
       "B = C@C'" "\<forall>n t. (n, receive\<langle>t\<rangle>\<^sub>s\<^sub>t) \<notin> set C'"
       "C = [] \<or> (\<exists>n t. suffix [(n,receive\<langle>t\<rangle>\<^sub>s\<^sub>t)] C)"
     by moura
   hence 1: "prefix C B" by simp
   hence 2: "prefix C A'" using assms(2) by simp
 
   have "\<And>m t. (m,receive\<langle>t\<rangle>\<^sub>s\<^sub>t) \<in> set B \<Longrightarrow> (m,receive\<langle>t\<rangle>\<^sub>s\<^sub>t) \<in> set C" using C by auto
   hence "\<And>t. receive\<langle>t\<rangle>\<^sub>s\<^sub>t \<in> set (proj_unl n B) \<Longrightarrow> receive\<langle>t\<rangle>\<^sub>s\<^sub>t \<in> set (proj_unl n C)"
     unfolding unlabel_def proj_def by force
   hence "ik\<^sub>s\<^sub>t (proj_unl n B) \<subseteq> ik\<^sub>s\<^sub>t (proj_unl n C)" using ik\<^sub>s\<^sub>t_is_rcv_set by auto
   hence 3: "ik\<^sub>s\<^sub>t (proj_unl n C) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> t \<cdot> \<I>" by (metis ideduct_mono[OF assms(3)] subst_all_mono)
 
   { fix D E m t assume  "suffix [(m, receive\<langle>t\<rangle>\<^sub>s\<^sub>t)] E" "prefix E A'" "A' \<in> set (tr\<^sub>p\<^sub>c A D)"
     hence "\<exists>F. prefix F A \<and> E \<in> set (tr\<^sub>p\<^sub>c F D)"
     proof (induction A D arbitrary: A' E rule: tr\<^sub>p\<^sub>c.induct)
       case (1 D) thus ?case by simp
     next
       case (2 i t' S D)
       note prems = "2.prems"
       note IH = "2.IH"
       obtain A'' where *: "A' = (i,send\<langle>t'\<rangle>\<^sub>s\<^sub>t)#A''" "A'' \<in> set (tr\<^sub>p\<^sub>c S D)"
         using prems(3) by auto
       have "E \<noteq> []" using prems(1) by auto
       then obtain E' where **: "E = (i,send\<langle>t'\<rangle>\<^sub>s\<^sub>t)#E'"
         using *(1) prems(2) by (cases E) auto
       hence "suffix [(m, receive\<langle>t\<rangle>\<^sub>s\<^sub>t)] E'" "prefix E' A''"
         using *(1) prems(1,2) suffix_Cons[of _ _ E'] by auto
       then obtain F where "prefix F S" "E' \<in> set (tr\<^sub>p\<^sub>c F D)"
         using *(2) ** IH by metis
       hence "prefix ((i,Send t')#F) ((i,Send t')#S)" "E \<in> set (tr\<^sub>p\<^sub>c ((i,Send t')#F) D)"
         using ** by auto
       thus ?case by metis
     next
       case (3 i t' S D)
       note prems = "3.prems"
       note IH = "3.IH"
       obtain A'' where *: "A' = (i,receive\<langle>t'\<rangle>\<^sub>s\<^sub>t)#A''" "A'' \<in> set (tr\<^sub>p\<^sub>c S D)"
         using prems(3) by auto
       have "E \<noteq> []" using prems(1) by auto
       then obtain E' where **: "E = (i,receive\<langle>t'\<rangle>\<^sub>s\<^sub>t)#E'"
         using *(1) prems(2) by (cases E) auto
       show ?case
       proof (cases "(m, receive\<langle>t\<rangle>\<^sub>s\<^sub>t) = (i, receive\<langle>t'\<rangle>\<^sub>s\<^sub>t)")
         case True
         note T = True
         show ?thesis
         proof (cases "suffix [(m, receive\<langle>t\<rangle>\<^sub>s\<^sub>t)] E'")
           case True
           hence "suffix [(m, receive\<langle>t\<rangle>\<^sub>s\<^sub>t)] E'" "prefix E' A''"
             using ** *(1) prems(1,2) by auto
           then obtain F where "prefix F S" "E' \<in> set (tr\<^sub>p\<^sub>c F D)"
             using *(2) ** IH by metis
           hence "prefix ((i,receive\<langle>t'\<rangle>)#F) ((i,receive\<langle>t'\<rangle>)#S)"
                 "E \<in> set (tr\<^sub>p\<^sub>c ((i,receive\<langle>t'\<rangle>)#F) D)"
             using ** by auto
           thus ?thesis by metis
         next
           case False
           hence "E' = []"
             using **(1) T prems(1)
                   suffix_Cons[of "[(m, receive\<langle>t\<rangle>\<^sub>s\<^sub>t)]" "(m, receive\<langle>t\<rangle>\<^sub>s\<^sub>t)" E']
             by auto
           hence "prefix [(i,receive\<langle>t'\<rangle>)] ((i,receive\<langle>t'\<rangle>) # S) \<and> E \<in> set (tr\<^sub>p\<^sub>c [(i,receive\<langle>t'\<rangle>)] D)"
             using * ** prems by auto
           thus ?thesis by metis
         qed
       next
         case False
         hence "suffix [(m, receive\<langle>t\<rangle>\<^sub>s\<^sub>t)] E'" "prefix E' A''"
           using ** *(1) prems(1,2) suffix_Cons[of _ _ E'] by auto
         then obtain F where "prefix F S" "E' \<in> set (tr\<^sub>p\<^sub>c F D)" using *(2) ** IH by metis
         hence "prefix ((i,receive\<langle>t'\<rangle>)#F) ((i,receive\<langle>t'\<rangle>)#S)" "E \<in> set (tr\<^sub>p\<^sub>c ((i,receive\<langle>t'\<rangle>)#F) D)"
           using ** by auto
         thus ?thesis by metis
       qed
     next
       case (4 i ac t' t'' S D)
       note prems = "4.prems"
       note IH = "4.IH"
       obtain A'' where *: "A' = (i,\<langle>ac: t' \<doteq> t''\<rangle>\<^sub>s\<^sub>t)#A''" "A'' \<in> set (tr\<^sub>p\<^sub>c S D)"
         using prems(3) by auto
       have "E \<noteq> []" using prems(1) by auto
       then obtain E' where **: "E = (i,\<langle>ac: t' \<doteq> t''\<rangle>\<^sub>s\<^sub>t)#E'"
         using *(1) prems(2) by (cases E) auto
       hence "suffix [(m, receive\<langle>t\<rangle>\<^sub>s\<^sub>t)] E'" "prefix E' A''"
         using *(1) prems(1,2) suffix_Cons[of _ _ E'] by auto
       then obtain F where "prefix F S" "E' \<in> set (tr\<^sub>p\<^sub>c F D)"
         using *(2) ** IH by metis
       hence "prefix ((i,Equality ac t' t'')#F) ((i,Equality ac t' t'')#S)"
             "E \<in> set (tr\<^sub>p\<^sub>c ((i,Equality ac t' t'')#F) D)"
         using ** by auto
       thus ?case by metis
     next
       case (5 i t' s S D)
       note prems = "5.prems"
       note IH = "5.IH"
       have *: "A' \<in> set (tr\<^sub>p\<^sub>c S (List.insert (i,t',s) D))" using prems(3) by auto
       have "E \<noteq> []" using prems(1) by auto
       hence "suffix [(m, receive\<langle>t\<rangle>\<^sub>s\<^sub>t)] E" "prefix E A'"
         using *(1) prems(1,2) suffix_Cons[of _ _ E] by auto
       then obtain F where "prefix F S" "E \<in> set (tr\<^sub>p\<^sub>c F (List.insert (i,t',s) D))"
         using * IH by metis
       hence "prefix ((i,insert\<langle>t',s\<rangle>)#F) ((i,insert\<langle>t',s\<rangle>)#S)"
             "E \<in> set (tr\<^sub>p\<^sub>c ((i,insert\<langle>t',s\<rangle>)#F) D)"
         by auto
       thus ?case by metis
     next
       case (6 i t' s S D)
       note prems = "6.prems"
       note IH = "6.IH"
 
       define constr where "constr = (\<lambda>Di.
         (map (\<lambda>d. (i,\<langle>check: (pair (t',s)) \<doteq> (pair (snd d))\<rangle>\<^sub>s\<^sub>t)) Di)@
         (map (\<lambda>d. (i,\<forall>[]\<langle>\<or>\<noteq>: [(pair (t',s), pair (snd d))]\<rangle>\<^sub>s\<^sub>t))
           (filter (\<lambda>d. d \<notin> set Di) (dbproj i D))))"
 
       obtain A'' Di where *:
           "A' = constr Di@A''" "A'' \<in> set (tr\<^sub>p\<^sub>c S (filter (\<lambda>d. d \<notin> set Di) D))"
           "Di \<in> set (subseqs (dbproj i D))"
         using prems(3) constr_def by auto
       have ***:  "(m, receive\<langle>t\<rangle>\<^sub>s\<^sub>t) \<notin> set (constr Di)" using constr_def by auto
       have "E \<noteq> []" using prems(1) by auto
       then obtain E' where **: "E = constr Di@E'"
         using *(1) prems(1,2) ***
         by (metis (mono_tags, lifting) Un_iff list.set_intros(1) prefixI prefix_def
                                        prefix_same_cases set_append suffix_def)
       hence "suffix [(m, receive\<langle>t\<rangle>\<^sub>s\<^sub>t)] E'" "prefix E' A''"
         using *(1) prems(1,2) suffix_append[of "[(m,receive\<langle>t\<rangle>\<^sub>s\<^sub>t)]" "constr Di" E'] ***
         by (metis (no_types, hide_lams) Nil_suffix append_Nil2 in_set_conv_decomp rev_exhaust
                                         snoc_suffix_snoc suffix_appendD,
             auto)
       then obtain F where "prefix F S" "E' \<in> set (tr\<^sub>p\<^sub>c F (filter (\<lambda>d. d \<notin> set Di) D))"
         using *(2,3) ** IH by metis
       hence "prefix ((i,delete\<langle>t',s\<rangle>)#F) ((i,delete\<langle>t',s\<rangle>)#S)"
             "E \<in> set (tr\<^sub>p\<^sub>c ((i,delete\<langle>t',s\<rangle>)#F) D)"
         using *(3) ** constr_def by auto
       thus ?case by metis
     next
       case (7 i ac t' s S D)
       note prems = "7.prems"
       note IH = "7.IH"
 
       define constr where "constr = (
         \<lambda>d::(('lbl strand_label \<times> ('fun,'var) term \<times> ('fun,'var) term)).
           (i,\<langle>ac: (pair (t',s)) \<doteq> (pair (snd d))\<rangle>\<^sub>s\<^sub>t))"
-      
+
       obtain A'' d where *: "A' = constr d#A''" "A'' \<in> set (tr\<^sub>p\<^sub>c S D)" "d \<in> set (dbproj i D)"
         using prems(3) constr_def by auto
       have "E \<noteq> []" using prems(1) by auto
       then obtain E' where **: "E = constr d#E'" using *(1) prems(2) by (cases E) auto
       hence "suffix [(m, receive\<langle>t\<rangle>\<^sub>s\<^sub>t)] E'" "prefix E' A''"
         using *(1) prems(1,2) suffix_Cons[of _ _ E'] using constr_def by auto
       then obtain F where "prefix F S" "E' \<in> set (tr\<^sub>p\<^sub>c F D)" using *(2) ** IH by metis
       hence "prefix ((i,InSet ac t' s)#F) ((i,InSet ac t' s)#S)"
             "E \<in> set (tr\<^sub>p\<^sub>c ((i,InSet ac t' s)#F) D)"
         using *(3) ** unfolding constr_def by auto
       thus ?case by metis
     next
       case (8 i X G G' S D)
       note prems = "8.prems"
       note IH = "8.IH"
 
       define constr where
         "constr = map (\<lambda>H. (i,\<forall>X\<langle>\<or>\<noteq>: (G@H)\<rangle>\<^sub>s\<^sub>t)) (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s G' (map snd (dbproj i D)))"
-      
+
       obtain A'' where *: "A' = constr@A''" "A'' \<in> set (tr\<^sub>p\<^sub>c S D)"
         using prems(3) constr_def by auto
       have ***:  "(m, receive\<langle>t\<rangle>\<^sub>s\<^sub>t) \<notin> set constr" using constr_def by auto
       have "E \<noteq> []" using prems(1) by auto
       then obtain E' where **: "E = constr@E'"
         using *(1) prems(1,2) ***
         by (metis (mono_tags, lifting) Un_iff list.set_intros(1) prefixI prefix_def
                                        prefix_same_cases set_append suffix_def)
       hence "suffix [(m, receive\<langle>t\<rangle>\<^sub>s\<^sub>t)] E'" "prefix E' A''"
         using *(1) prems(1,2) suffix_append[of "[(m,receive\<langle>t\<rangle>\<^sub>s\<^sub>t)]" constr E'] ***
         by (metis (no_types, hide_lams) Nil_suffix append_Nil2 in_set_conv_decomp rev_exhaust
                                         snoc_suffix_snoc suffix_appendD,
             auto)
       then obtain F where "prefix F S" "E' \<in> set (tr\<^sub>p\<^sub>c F D)" using *(2) ** IH by metis
       hence "prefix ((i,NegChecks X G G')#F) ((i,NegChecks X G G')#S)"
             "E \<in> set (tr\<^sub>p\<^sub>c ((i,NegChecks X G G')#F) D)"
         using ** constr_def by auto
       thus ?case by metis
     qed
   }
   moreover have "prefix [] A" "[] \<in> set (tr\<^sub>p\<^sub>c [] [])" by auto
   ultimately have 4: "\<exists>D. prefix D A \<and> C \<in> set (tr\<^sub>p\<^sub>c D [])" using C(3) assms(1) 2 by blast
 
   show ?thesis by (metis 1 3 4)
 qed
 
 
 subsection \<open>Theorem: Semantic Equivalence of Translation\<close>
 context
 begin
 
 text \<open>
   An alternative version of the translation that does not perform database-state projections.
   It is used as an intermediate step in the proof of semantic equivalence.
 \<close>
 private fun tr'\<^sub>p\<^sub>c::
   "('fun,'var,'lbl) labeled_stateful_strand \<Rightarrow> ('fun,'var,'lbl) labeleddbstatelist
    \<Rightarrow> ('fun,'var,'lbl) labeled_strand list"
 where
   "tr'\<^sub>p\<^sub>c [] D = [[]]"
 | "tr'\<^sub>p\<^sub>c ((i,send\<langle>t\<rangle>)#A) D = map ((#) (i,send\<langle>t\<rangle>\<^sub>s\<^sub>t)) (tr'\<^sub>p\<^sub>c A D)"
 | "tr'\<^sub>p\<^sub>c ((i,receive\<langle>t\<rangle>)#A) D = map ((#) (i,receive\<langle>t\<rangle>\<^sub>s\<^sub>t)) (tr'\<^sub>p\<^sub>c A D)"
 | "tr'\<^sub>p\<^sub>c ((i,\<langle>ac: t \<doteq> t'\<rangle>)#A) D = map ((#) (i,\<langle>ac: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t)) (tr'\<^sub>p\<^sub>c A D)"
 | "tr'\<^sub>p\<^sub>c ((i,insert\<langle>t,s\<rangle>)#A) D = tr'\<^sub>p\<^sub>c A (List.insert (i,(t,s)) D)"
 | "tr'\<^sub>p\<^sub>c ((i,delete\<langle>t,s\<rangle>)#A) D = (
     concat (map (\<lambda>Di. map (\<lambda>B. (map (\<lambda>d. (i,\<langle>check: (pair (t,s)) \<doteq> (pair (snd d))\<rangle>\<^sub>s\<^sub>t)) Di)@
                                (map (\<lambda>d. (i,\<forall>[]\<langle>\<or>\<noteq>: [(pair (t,s), pair (snd d))]\<rangle>\<^sub>s\<^sub>t))
                                     [d\<leftarrow>D. d \<notin> set Di])@B)
                           (tr'\<^sub>p\<^sub>c A [d\<leftarrow>D. d \<notin> set Di]))
                 (subseqs D)))"
 | "tr'\<^sub>p\<^sub>c ((i,\<langle>ac: t \<in> s\<rangle>)#A) D =
     concat (map (\<lambda>B. map (\<lambda>d. (i,\<langle>ac: (pair (t,s)) \<doteq> (pair (snd d))\<rangle>\<^sub>s\<^sub>t)#B) D) (tr'\<^sub>p\<^sub>c A D))"
 | "tr'\<^sub>p\<^sub>c ((i,\<forall>X\<langle>\<or>\<noteq>: F \<or>\<notin>: F'\<rangle>)#A) D =
     map ((@) (map (\<lambda>G. (i,\<forall>X\<langle>\<or>\<noteq>: (F@G)\<rangle>\<^sub>s\<^sub>t)) (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' (map snd D)))) (tr'\<^sub>p\<^sub>c A D)"
 
 subsubsection \<open>Part 1\<close>
 private lemma tr'_par_iff_unlabel_tr:
   assumes "\<forall>(i,p) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<union> set D.
            \<forall>(j,q) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<union> set D.
               p = q \<longrightarrow> i = j"
   shows "(\<exists>C \<in> set (tr'\<^sub>p\<^sub>c A D). B = unlabel C) \<longleftrightarrow> B \<in> set (tr (unlabel A) (unlabel D))"
     (is "?A \<longleftrightarrow> ?B")
 proof
   { fix C have "C \<in> set (tr'\<^sub>p\<^sub>c A D) \<Longrightarrow> unlabel C \<in> set (tr (unlabel A) (unlabel D))" using assms
     proof (induction A D arbitrary: C rule: tr'\<^sub>p\<^sub>c.induct)
       case (5 i t s S D)
       hence "unlabel C \<in> set (tr (unlabel S) (unlabel (List.insert (i, t, s) D)))"
         by (auto simp add: setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def)
       moreover have
           "insert (i,t,s) (set D) \<subseteq> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((i,insert\<langle>t,s\<rangle>)#S) \<union> set D"
         by (auto simp add: setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def)
       hence "\<forall>(j,p) \<in> insert (i,t,s) (set D). \<forall>(k,q) \<in> insert (i,t,s) (set D). p = q \<longrightarrow> j = k"
         using "5.prems"(2) by blast
       hence "unlabel (List.insert (i, t, s) D) = (List.insert (t, s) (unlabel D))"
         using map_snd_list_insert_distrib[of "(i,t,s)" D] unfolding unlabel_def by simp
       ultimately show ?case by auto
     next
       case (6 i t s S D)
       let ?f1 = "\<lambda>d. \<langle>check: (pair (t,s)) \<doteq> (pair d)\<rangle>\<^sub>s\<^sub>t"
       let ?g1 = "\<lambda>d. \<forall>[]\<langle>\<or>\<noteq>: [(pair (t,s), pair d)]\<rangle>\<^sub>s\<^sub>t"
       let ?f2 = "\<lambda>d. (i, ?f1 (snd d))"
       let ?g2 = "\<lambda>d. (i, ?g1 (snd d))"
-  
+
       define constr1 where "constr1 = (\<lambda>Di. (map ?f1 Di)@(map ?g1 [d\<leftarrow>unlabel D. d \<notin> set Di]))"
       define constr2 where "constr2 = (\<lambda>Di. (map ?f2 Di)@(map ?g2 [d\<leftarrow>D. d \<notin> set Di]))"
-  
+
       obtain C' Di where C':
           "Di \<in> set (subseqs D)"
           "C = constr2 Di@C'"
           "C' \<in> set (tr'\<^sub>p\<^sub>c S [d\<leftarrow>D. d \<notin> set Di])"
         using "6.prems"(1) unfolding constr2_def by moura
-      
+
       have 0: "set [d\<leftarrow>D. d \<notin> set Di] \<subseteq> set D"
               "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \<subseteq> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((i, delete\<langle>t,s\<rangle>)#S)"
         by (auto simp add: setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def)
       hence 1:
           "\<forall>(j, p) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \<union> set [d\<leftarrow>D. d \<notin> set Di].
            \<forall>(k, q) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \<union> set [d\<leftarrow>D. d \<notin> set Di].
             p = q \<longrightarrow> j = k"
         using "6.prems"(2) by blast
-  
+
       have "\<forall>(i,p) \<in> set D \<union> set Di. \<forall>(j,q) \<in> set D \<union> set Di. p = q \<longrightarrow> i = j"
         using "6.prems"(2) subseqs_set_subset(1)[OF C'(1)] by blast
       hence 2: "unlabel [d\<leftarrow>D. d \<notin> set Di] = [d\<leftarrow>unlabel D. d \<notin> set (unlabel Di)]"
         using unlabel_filter_eq[of D "set Di"] unfolding unlabel_def by simp
-  
+
       have 3:
           "\<And>f g::('a \<times> 'a \<Rightarrow> 'c). \<And>A B::(('b \<times> 'a \<times> 'a) list).
               map snd ((map (\<lambda>d. (i, f (snd d))) A)@(map (\<lambda>d. (i, g (snd d))) B)) =
               map f (map snd A)@map g (map snd B)"
         by simp
       have "unlabel (constr2 Di) = constr1 (unlabel Di)"
         using 2 3[of ?f1 Di ?g1 "[d\<leftarrow>D. d \<notin> set Di]"]
         by (simp add: constr1_def constr2_def unlabel_def)
       hence 4: "unlabel C = constr1 (unlabel Di)@unlabel C'"
         using C'(2) unlabel_append by metis
-  
+
       have "unlabel Di \<in> set (map unlabel (subseqs D))"
         using C'(1) unfolding unlabel_def by simp
       hence 5: "unlabel Di \<in> set (subseqs (unlabel D))"
         using map_subseqs[of snd D] unfolding unlabel_def by simp
-  
+
       show ?case using "6.IH"[OF C'(1,3) 1] 2 4 5 unfolding constr1_def by auto
     next
       case (7 i ac t s S D)
       obtain C' d  where C':
           "C = (i,\<langle>ac: (pair (t,s)) \<doteq> (pair (snd d))\<rangle>\<^sub>s\<^sub>t)#C'"
           "C' \<in> set (tr'\<^sub>p\<^sub>c S D)" "d \<in> set D"
         using "7.prems"(1) by moura
-  
+
       have "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \<union> set D \<subseteq> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((i,InSet ac t s)#S) \<union> set D"
         by (auto simp add: setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def)
       hence "\<forall>(j, p) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \<union> set D.
              \<forall>(k, q) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \<union> set D.
               p = q \<longrightarrow> j = k"
         using "7.prems"(2) by blast
       hence "unlabel C' \<in> set (tr (unlabel S) (unlabel D))" using "7.IH"[OF C'(2)] by auto
       thus ?case using C' unfolding unlabel_def by force
     next
       case (8 i X F F' S D)
       obtain C' where C':
           "C = map (\<lambda>G. (i,\<forall>X\<langle>\<or>\<noteq>: (F@G)\<rangle>\<^sub>s\<^sub>t)) (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' (map snd D))@C'"
           "C' \<in> set (tr'\<^sub>p\<^sub>c S D)"
         using "8.prems"(1) by moura
-  
+
       have "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \<union> set D \<subseteq> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((i,NegChecks X F F')#S) \<union> set D"
         by (auto simp add: setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def)
       hence "\<forall>(j, p) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \<union> set D.
              \<forall>(k, q) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \<union> set D.
               p = q \<longrightarrow> j = k"
         using "8.prems"(2) by blast
       hence "unlabel C' \<in> set (tr (unlabel S) (unlabel D))" using "8.IH"[OF C'(2)] by auto
       thus ?case using C' unfolding unlabel_def by auto
     qed (auto simp add: setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def)
   } thus "?A \<Longrightarrow> ?B" by blast
 
   show "?B \<Longrightarrow> ?A" using assms
   proof (induction A arbitrary: B D)
     case (Cons a A)
     obtain ia sa where a: "a = (ia,sa)" by moura
 
     have "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<subseteq> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t (a#A)" using a by (cases sa) (auto simp add: setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def)
     hence 1: "\<forall>(j, p) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<union> set D.
               \<forall>(k, q) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<union> set D.
                 p = q \<longrightarrow> j = k"
       using Cons.prems(2) by blast
 
     show ?case
     proof (cases sa)
       case (Send t)
       then obtain B' where B':
           "B = send\<langle>t\<rangle>\<^sub>s\<^sub>t#B'"
           "B' \<in> set (tr (unlabel A) (unlabel D))"
         using Cons.prems(1) a by auto
       thus ?thesis using Cons.IH[OF B'(2) 1] a B'(1) Send by auto
     next
       case (Receive t)
       then obtain B' where B':
           "B = receive\<langle>t\<rangle>\<^sub>s\<^sub>t#B'"
           "B' \<in> set (tr (unlabel A) (unlabel D))"
         using Cons.prems(1) a by auto
       thus ?thesis using Cons.IH[OF B'(2) 1] a B'(1) Receive by auto
     next
       case (Equality ac t t')
       then obtain B' where B':
           "B = \<langle>ac: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t#B'"
           "B' \<in> set (tr (unlabel A) (unlabel D))"
         using Cons.prems(1) a by auto
       thus ?thesis using Cons.IH[OF B'(2) 1] a B'(1) Equality by auto
     next
       case (Insert t s)
       hence B: "B \<in> set (tr (unlabel A) (List.insert (t,s) (unlabel D)))"
         using Cons.prems(1) a by auto
 
       let ?P = "\<lambda>i. List.insert (t,s) (unlabel D) = unlabel (List.insert (i,t,s) D)"
 
       { obtain j where j: "?P j" "j = ia \<or> (j,t,s) \<in> set D"
           using labeled_list_insert_eq_ex_cases[of "(t,s)" D ia] by moura
         hence "j = ia" using Cons.prems(2) a Insert by (auto simp add: setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def)
         hence "?P ia" using j(1) by metis
       } hence j: "?P ia" by metis
-      
+
       have 2: "\<forall>(k1, p) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<union> set (List.insert (ia,t,s) D).
                \<forall>(k2, q) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<union> set (List.insert (ia,t,s) D).
                  p = q \<longrightarrow> k1 = k2"
         using Cons.prems(2) a Insert by (auto simp add: setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def)
 
       show ?thesis using Cons.IH[OF _ 2] j(1) B Insert a by auto
     next
       case (Delete t s)
       define c where "c \<equiv> (\<lambda>(i::'lbl strand_label) Di.
         map (\<lambda>d. (i,\<langle>check: (pair (t,s)) \<doteq> (pair (snd d))\<rangle>\<^sub>s\<^sub>t)) Di@
         map (\<lambda>d. (i,\<forall>[]\<langle>\<or>\<noteq>: [(pair (t,s), pair (snd d))]\<rangle>\<^sub>s\<^sub>t)) [d\<leftarrow>D. d \<notin> set Di])"
-      
+
       define d where "d \<equiv> (\<lambda>Di.
         map (\<lambda>d. \<langle>check: (pair (t,s)) \<doteq> (pair d)\<rangle>\<^sub>s\<^sub>t) Di@
         map (\<lambda>d. \<forall>[]\<langle>\<or>\<noteq>: [(pair (t,s), pair d)]\<rangle>\<^sub>s\<^sub>t) [d\<leftarrow>unlabel D. d \<notin> set Di])"
 
       obtain B' Di where B':
           "B = d Di@B'" "Di \<in> set (subseqs (unlabel D))"
           "B' \<in> set (tr (unlabel A) [d\<leftarrow>unlabel D. d \<notin> set Di])"
         using Cons.prems(1) a Delete unfolding d_def by auto
 
       obtain Di' where Di': "Di' \<in> set (subseqs D)" "unlabel Di' = Di"
         using unlabel_subseqsD[OF B'(2)] by moura
 
       have 2: "\<forall>(j, p) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<union> set [d\<leftarrow>D. d \<notin> set Di'].
                \<forall>(k, q) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<union> set [d\<leftarrow>D. d \<notin> set Di'].
                  p = q \<longrightarrow> j = k"
         using 1 subseqs_subset[OF Di'(1)]
               filter_is_subset[of "\<lambda>d. d \<notin> set Di'"]
         by blast
 
       have "set Di' \<subseteq> set D" by (rule subseqs_subset[OF Di'(1)])
       hence "\<forall>(j, p)\<in>set D \<union> set Di'. \<forall>(k, q)\<in>set D \<union> set Di'. p = q \<longrightarrow> j = k"
         using Cons.prems(2) by blast
       hence 3: "[d\<leftarrow>unlabel D. d \<notin> set Di] = unlabel [d\<leftarrow>D. d \<notin> set Di']"
         using Di'(2) unlabel_filter_eq[of D "set Di'"] unfolding unlabel_def by auto
-      
+
       obtain C where C: "C \<in> set (tr'\<^sub>p\<^sub>c A [d\<leftarrow>D. d \<notin> set Di'])" "B' = unlabel C"
         using 3 Cons.IH[OF _ 2] B'(3) by auto
       hence 4: "c ia Di'@C \<in> set (tr'\<^sub>p\<^sub>c (a#A) D)" using Di'(1) a Delete unfolding c_def by auto
 
       have "unlabel (c ia Di') = d Di" using Di' 3 unfolding c_def d_def unlabel_def by auto
       hence 5: "B = unlabel (c ia Di'@C)" using B'(1) C(2) unlabel_append[of "c ia Di'" C] by simp
-      
+
       show ?thesis using 4 5 by blast
     next
       case (InSet ac t s)
       then obtain B' d where B':
           "B = \<langle>ac: (pair (t,s)) \<doteq> (pair d)\<rangle>\<^sub>s\<^sub>t#B'"
           "B' \<in> set (tr (unlabel A) (unlabel D))"
           "d \<in> set (unlabel D)"
         using Cons.prems(1) a by auto
       thus ?thesis using Cons.IH[OF _ 1] a InSet unfolding unlabel_def by auto
     next
       case (NegChecks X F F')
-      then obtain B' where B': 
+      then obtain B' where B':
           "B = map (\<lambda>G. \<forall>X\<langle>\<or>\<noteq>: (F@G)\<rangle>\<^sub>s\<^sub>t) (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' (unlabel D))@B'"
           "B' \<in> set (tr (unlabel A) (unlabel D))"
         using Cons.prems(1) a by auto
       thus ?thesis using Cons.IH[OF _ 1] a NegChecks unfolding unlabel_def by auto
     qed
   qed simp
 qed
 
 subsubsection \<open>Part 2\<close>
 private lemma tr_par_iff_tr'_par:
   assumes "\<forall>(i,p) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<union> set D. \<forall>(j,q) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<union> set D.
             (\<exists>\<delta>. Unifier \<delta> (pair p) (pair q)) \<longrightarrow> i = j"
     (is "?R3 A D")
   and "\<forall>(l,t,s) \<in> set D. (fv t \<union> fv s) \<inter> bvars\<^sub>s\<^sub>s\<^sub>t (unlabel A) = {}" (is "?R4 A D")
   and "fv\<^sub>s\<^sub>s\<^sub>t (unlabel A) \<inter> bvars\<^sub>s\<^sub>s\<^sub>t (unlabel A) = {}" (is "?R5 A D")
   shows "(\<exists>B \<in> set (tr\<^sub>p\<^sub>c A D). \<lbrakk>M; unlabel B\<rbrakk>\<^sub>d \<I>) \<longleftrightarrow> (\<exists>C \<in> set (tr'\<^sub>p\<^sub>c A D). \<lbrakk>M; unlabel C\<rbrakk>\<^sub>d \<I>)"
     (is "?P \<longleftrightarrow> ?Q")
 proof
   { fix B assume "B \<in> set (tr\<^sub>p\<^sub>c A D)" "\<lbrakk>M; unlabel B\<rbrakk>\<^sub>d \<I>"
     hence ?Q using assms
     proof (induction A D arbitrary: B M rule: tr\<^sub>p\<^sub>c.induct)
       case (1 D) thus ?case by simp
     next
       case (2 i t S D)
       note prems = "2.prems"
       note IH = "2.IH"
 
       obtain B' where B': "B = (i,send\<langle>t\<rangle>\<^sub>s\<^sub>t)#B'" "B' \<in> set (tr\<^sub>p\<^sub>c S D)"
         using prems(1) by moura
-          
+
       have 1: "\<lbrakk>M; unlabel B'\<rbrakk>\<^sub>d \<I>" using prems(2) B'(1) by simp
       have 4: "?R3 S D" using prems(3) by (auto simp add: setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def)
       have 5: "?R4 S D" using prems(4) by force
       have 6: "?R5 S D" using prems(5) by force
 
       have 7: "M \<turnstile> t \<cdot> \<I>" using prems(2) B'(1) by simp
 
       obtain C where C: "C \<in> set (tr'\<^sub>p\<^sub>c S D)" "\<lbrakk>M; unlabel C\<rbrakk>\<^sub>d \<I>"
         using IH[OF B'(2) 1 4 5 6] by moura
       hence "((i,send\<langle>t\<rangle>\<^sub>s\<^sub>t)#C) \<in> set (tr'\<^sub>p\<^sub>c ((i,Send t)#S) D)" "\<lbrakk>M; unlabel ((i,send\<langle>t\<rangle>\<^sub>s\<^sub>t)#C)\<rbrakk>\<^sub>d \<I>"
         using 7 by auto
       thus ?case by metis
     next
       case (3 i t S D)
       note prems = "3.prems"
       note IH = "3.IH"
 
       obtain B' where B': "B = (i,receive\<langle>t\<rangle>\<^sub>s\<^sub>t)#B'" "B' \<in> set (tr\<^sub>p\<^sub>c S D)" using prems(1) by moura
-          
+
       have 1: "\<lbrakk>insert (t \<cdot> \<I>) M; unlabel B'\<rbrakk>\<^sub>d \<I> " using prems(2) B'(1) by simp
       have 4: "?R3 S D" using prems(3) by (auto simp add: setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def)
       have 5: "?R4 S D" using prems(4) by force
       have 6: "?R5 S D" using prems(5) by force
 
       obtain C where C: "C \<in> set (tr'\<^sub>p\<^sub>c S D)" "\<lbrakk>insert (t \<cdot> \<I>) M; unlabel C\<rbrakk>\<^sub>d \<I>"
         using IH[OF B'(2) 1 4 5 6] by moura
       hence "((i,receive\<langle>t\<rangle>\<^sub>s\<^sub>t)#C) \<in> set (tr'\<^sub>p\<^sub>c ((i,receive\<langle>t\<rangle>)#S) D)"
             "\<lbrakk>insert (t \<cdot> \<I>) M; unlabel ((i,receive\<langle>t\<rangle>\<^sub>s\<^sub>t)#C)\<rbrakk>\<^sub>d \<I>"
         by auto
       thus ?case by auto
     next
       case (4 i ac t t' S D)
       note prems = "4.prems"
       note IH = "4.IH"
 
       obtain B' where B': "B = (i,\<langle>ac: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t)#B'" "B' \<in> set (tr\<^sub>p\<^sub>c S D)"
         using prems(1) by moura
-          
+
       have 1: "\<lbrakk>M; unlabel B'\<rbrakk>\<^sub>d \<I> " using prems(2) B'(1) by simp
       have 4: "?R3 S D" using prems(3) by (auto simp add: setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def)
       have 5: "?R4 S D" using prems(4) by force
       have 6: "?R5 S D" using prems(5) by force
 
       have 7: "t \<cdot> \<I> = t' \<cdot> \<I>" using prems(2) B'(1) by simp
 
       obtain C where C: "C \<in> set (tr'\<^sub>p\<^sub>c S D)" "\<lbrakk>M; unlabel C\<rbrakk>\<^sub>d \<I>"
         using IH[OF B'(2) 1 4 5 6] by moura
       hence "((i,\<langle>ac: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t)#C) \<in> set (tr'\<^sub>p\<^sub>c ((i,Equality ac t t')#S) D)"
             "\<lbrakk>M; unlabel ((i,\<langle>ac: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t)#C)\<rbrakk>\<^sub>d \<I>"
         using 7 by auto
       thus ?case by metis
     next
       case (5 i t s S D)
       note prems = "5.prems"
       note IH = "5.IH"
 
       have B: "B \<in> set (tr\<^sub>p\<^sub>c S (List.insert (i,t,s) D))" using prems(1) by simp
-          
+
       have 1: "\<lbrakk>M; unlabel B\<rbrakk>\<^sub>d \<I> " using prems(2) B(1) by simp
       have 4: "?R3 S (List.insert (i,t,s) D)" using prems(3) by (auto simp add: setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def)
       have 5: "?R4 S (List.insert (i,t,s) D)" using prems(4,5) by force
       have 6: "?R5 S D" using prems(5) by force
 
       show ?case using IH[OF B(1) 1 4 5 6] by simp
     next
       case (6 i t s S D)
       note prems = "6.prems"
       note IH = "6.IH"
 
       let ?cl1 = "\<lambda>Di. map (\<lambda>d. (i,\<langle>check: (pair (t,s)) \<doteq> (pair (snd d))\<rangle>\<^sub>s\<^sub>t)) Di"
       let ?cu1 = "\<lambda>Di. map (\<lambda>d. \<langle>check: (pair (t,s)) \<doteq> (pair (snd d))\<rangle>\<^sub>s\<^sub>t) Di"
       let ?cl2 = "\<lambda>Di. map (\<lambda>d. (i,\<forall>[]\<langle>\<or>\<noteq>: [(pair (t,s), pair (snd d))]\<rangle>\<^sub>s\<^sub>t)) [d\<leftarrow>dbproj i D. d\<notin>set Di]"
       let ?cu2 = "\<lambda>Di. map (\<lambda>d. \<forall>[]\<langle>\<or>\<noteq>: [(pair (t,s), pair (snd d))]\<rangle>\<^sub>s\<^sub>t) [d\<leftarrow>dbproj i D. d\<notin>set Di]"
 
       let ?dl1 = "\<lambda>Di. map (\<lambda>d. (i,\<langle>check: (pair (t,s)) \<doteq> (pair (snd d))\<rangle>\<^sub>s\<^sub>t)) Di"
       let ?du1 = "\<lambda>Di. map (\<lambda>d. \<langle>check: (pair (t,s)) \<doteq> (pair (snd d))\<rangle>\<^sub>s\<^sub>t) Di"
       let ?dl2 = "\<lambda>Di. map (\<lambda>d. (i,\<forall>[]\<langle>\<or>\<noteq>: [(pair (t,s), pair (snd d))]\<rangle>\<^sub>s\<^sub>t)) [d\<leftarrow>D. d\<notin>set Di]"
       let ?du2 = "\<lambda>Di. map (\<lambda>d. \<forall>[]\<langle>\<or>\<noteq>: [(pair (t,s), pair (snd d))]\<rangle>\<^sub>s\<^sub>t) [d\<leftarrow>D. d\<notin>set Di]"
 
       define c where c: "c = (\<lambda>Di. ?cl1 Di@?cl2 Di)"
       define d where d: "d = (\<lambda>Di. ?dl1 Di@?dl2 Di)"
 
       obtain B' Di where B':
           "Di \<in> set (subseqs (dbproj i D))" "B = c Di@B'" "B' \<in> set (tr\<^sub>p\<^sub>c S [d\<leftarrow>D. d \<notin> set Di])"
         using prems(1) c by moura
 
       have 0: "ik\<^sub>s\<^sub>t (unlabel (c Di)) = {}" "ik\<^sub>s\<^sub>t (unlabel (d Di)) = {}"
               "unlabel (?cl1 Di) = ?cu1 Di" "unlabel (?cl2 Di) = ?cu2 Di"
               "unlabel (?dl1 Di) = ?du1 Di" "unlabel (?dl2 Di) = ?du2 Di"
         unfolding c d unlabel_def by force+
 
       have 1: "\<lbrakk>M; unlabel B'\<rbrakk>\<^sub>d \<I> " using prems(2) B'(2) 0(1) unfolding unlabel_def by auto
 
       { fix j p k q
         assume "(j, p) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \<union> set [d\<leftarrow>D. d \<notin> set Di]"
                "(k, q) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \<union> set [d\<leftarrow>D. d \<notin> set Di]"
         hence "(j, p) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((i, delete\<langle>t,s\<rangle>)#S) \<union> set D"
               "(k, q) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((i, delete\<langle>t,s\<rangle>)#S) \<union> set D"
           using dbproj_subseq_subset[OF B'(1)] by (auto simp add: setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def)
         hence "(\<exists>\<delta>. Unifier \<delta> (pair p) (pair q)) \<Longrightarrow> j = k" using prems(3) by blast
       } hence 4: "?R3 S [d\<leftarrow>D. d \<notin> set Di]" by blast
-      
+
       have 5: "?R4 S (filter (\<lambda>d. d \<notin> set Di) D)" using prems(4) by force
       have 6: "?R5 S D" using prems(5) by force
 
       obtain C where C: "C \<in> set (tr'\<^sub>p\<^sub>c S [d\<leftarrow>D . d \<notin> set Di])" "\<lbrakk>M; unlabel C\<rbrakk>\<^sub>d \<I>"
         using IH[OF B'(1,3) 1 4 5 6] by moura
 
       have 7: "\<lbrakk>M; unlabel (c Di)\<rbrakk>\<^sub>d \<I>" "\<lbrakk>M; unlabel B'\<rbrakk>\<^sub>d \<I>"
         using prems(2) B'(2) 0(1) strand_sem_split(3,4)[of M "unlabel (c Di)" "unlabel B'"]
         unfolding c unlabel_def by auto
 
-      have "\<lbrakk>M; unlabel (?cl2 Di)\<rbrakk>\<^sub>d \<I>" using 7(1) 0(1) unfolding c unlabel_def by auto 
+      have "\<lbrakk>M; unlabel (?cl2 Di)\<rbrakk>\<^sub>d \<I>" using 7(1) 0(1) unfolding c unlabel_def by auto
       hence "\<lbrakk>M; ?cu2 Di\<rbrakk>\<^sub>d \<I>" by (metis 0(4))
       moreover {
         fix j p k q
         assume "(j, p) \<in> {(i, t, s)} \<union> set D \<union> set Di"
                "(k, q) \<in> {(i, t, s)} \<union> set D \<union> set Di"
         hence "(j, p) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((i, delete\<langle>t,s\<rangle>)#S) \<union> set D"
               "(k, q) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((i, delete\<langle>t,s\<rangle>)#S) \<union> set D"
           using dbproj_subseq_subset[OF B'(1)] by (auto simp add: setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def)
         hence "(\<exists>\<delta>. Unifier \<delta> (pair p) (pair q)) \<Longrightarrow> j = k" using prems(3) by blast
       } hence "\<forall>(j, p) \<in> {(i, t, s)} \<union> set D \<union> set Di.
                \<forall>(k, q) \<in> {(i, t, s)} \<union> set D \<union> set Di.
                 (\<exists>\<delta>. Unifier \<delta> (pair p) (pair q)) \<longrightarrow> j = k"
         by blast
       ultimately have "\<lbrakk>M; ?du2 Di\<rbrakk>\<^sub>d \<I>" using labeled_sat_ineq_lift by simp
       hence "\<lbrakk>M; unlabel (?dl2 Di)\<rbrakk>\<^sub>d \<I>" by (metis 0(6))
       moreover have "\<lbrakk>M; unlabel (?cl1 Di)\<rbrakk>\<^sub>d \<I>" using 7(1) unfolding c unlabel_def by auto
       hence "\<lbrakk>M; unlabel (?dl1 Di)\<rbrakk>\<^sub>d \<I>" by (metis 0(3,5))
       ultimately have "\<lbrakk>M; unlabel (d Di)\<rbrakk>\<^sub>d \<I>" using 0(2) unfolding c d unlabel_def by force
       hence 8: "\<lbrakk>M; unlabel (d Di@C)\<rbrakk>\<^sub>d \<I>" using 0(2) C(2) unfolding unlabel_def by auto
 
       have 9: "d Di@C \<in> set (tr'\<^sub>p\<^sub>c ((i,delete\<langle>t,s\<rangle>)#S) D)"
         using C(1) dbproj_subseq_in_subseqs[OF B'(1)]
         unfolding d unlabel_def by auto
 
       show ?case by (metis 8 9)
     next
       case (7 i ac t s S D)
       note prems = "7.prems"
       note IH = "7.IH"
 
       obtain B' d where B':
           "B = (i,\<langle>ac: (pair (t,s)) \<doteq> (pair (snd d))\<rangle>\<^sub>s\<^sub>t)#B'"
           "B' \<in> set (tr\<^sub>p\<^sub>c S D)" "d \<in> set (dbproj i D)"
         using prems(1) by moura
 
       have 1: "\<lbrakk>M; unlabel B'\<rbrakk>\<^sub>d \<I> " using prems(2) B'(1) by simp
 
       { fix j p k q
         assume "(j,p) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \<union> set D"
                "(k,q) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \<union> set D"
         hence "(j,p) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((i, InSet ac t s)#S) \<union> set D"
               "(k,q) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((i, InSet ac t s)#S) \<union> set D"
           by (auto simp add: setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def)
         hence "(\<exists>\<delta>. Unifier \<delta> (pair p) (pair q)) \<Longrightarrow> j = k" using prems(3) by blast
       } hence 4: "?R3 S D" by blast
 
       have 5: "?R4 S D" using prems(4) by force
       have 6: "?R5 S D" using prems(5) by force
       have 7: "pair (t,s) \<cdot> \<I> = pair (snd d) \<cdot> \<I>" using prems(2) B'(1) by simp
 
       obtain C where C: "C \<in> set (tr'\<^sub>p\<^sub>c S D)" "\<lbrakk>M; unlabel C\<rbrakk>\<^sub>d \<I>"
         using IH[OF B'(2) 1 4 5 6] by moura
       hence "((i,\<langle>ac: (pair (t,s)) \<doteq> (pair (snd d))\<rangle>\<^sub>s\<^sub>t)#C) \<in> set (tr'\<^sub>p\<^sub>c ((i,InSet ac t s)#S) D)"
             "\<lbrakk>M; unlabel ((i,\<langle>ac: (pair (t,s)) \<doteq> (pair (snd d))\<rangle>\<^sub>s\<^sub>t)#C)\<rbrakk>\<^sub>d \<I>"
         using 7 B'(3) by auto
       thus ?case by metis
     next
       case (8 i X F F' S D)
       note prems = "8.prems"
       note IH = "8.IH"
 
       let ?cl = "map (\<lambda>G. (i,\<forall>X\<langle>\<or>\<noteq>: (F@G)\<rangle>\<^sub>s\<^sub>t)) (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' (map snd (dbproj i D)))"
       let ?cu = "map (\<lambda>G. \<forall>X\<langle>\<or>\<noteq>: (F@G)\<rangle>\<^sub>s\<^sub>t) (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' (map snd (dbproj i D)))"
 
       let ?dl = "map (\<lambda>G. (i,\<forall>X\<langle>\<or>\<noteq>: (F@G)\<rangle>\<^sub>s\<^sub>t)) (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' (map snd D))"
       let ?du = "map (\<lambda>G. \<forall>X\<langle>\<or>\<noteq>: (F@G)\<rangle>\<^sub>s\<^sub>t) (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' (map snd D))"
 
       define c where c: "c = ?cl"
       define d where d: "d = ?dl"
 
       obtain B' where B': "B = c@B'" "B' \<in> set (tr\<^sub>p\<^sub>c S D)" using prems(1) c by moura
 
       have 0: "ik\<^sub>s\<^sub>t (unlabel c) = {}" "ik\<^sub>s\<^sub>t (unlabel d) = {}"
-              "unlabel ?cl = ?cu" "unlabel ?dl = ?du" 
+              "unlabel ?cl = ?cu" "unlabel ?dl = ?du"
         unfolding c d unlabel_def by force+
 
       have "ik\<^sub>s\<^sub>t (unlabel c) = {}" unfolding c unlabel_def by force
       hence 1: "\<lbrakk>M; unlabel B'\<rbrakk>\<^sub>d \<I> " using prems(2) B'(1) unfolding unlabel_def by auto
 
       have "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \<subseteq> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((i, NegChecks X F F')#S)" by (auto simp add: setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def)
       hence 4: "?R3 S D" using prems(3) by blast
 
       have 5: "?R4 S D" using prems(4) by force
       have 6: "?R5 S D" using prems(5) by force
 
       obtain C where C: "C \<in> set (tr'\<^sub>p\<^sub>c S D)" "\<lbrakk>M; unlabel C\<rbrakk>\<^sub>d \<I>"
         using IH[OF B'(2) 1 4 5 6] by moura
 
       have 7: "\<lbrakk>M; unlabel c\<rbrakk>\<^sub>d \<I>" "\<lbrakk>M; unlabel B'\<rbrakk>\<^sub>d \<I>"
         using prems(2) B'(1) 0(1) strand_sem_split(3,4)[of M "unlabel c" "unlabel B'"]
         unfolding c unlabel_def by auto
 
       have 8: "d@C \<in> set (tr'\<^sub>p\<^sub>c ((i,NegChecks X F F')#S) D)"
         using C(1) unfolding d unlabel_def by auto
 
-      have "\<lbrakk>M; unlabel ?cl\<rbrakk>\<^sub>d \<I>" using 7(1) unfolding c unlabel_def by auto 
+      have "\<lbrakk>M; unlabel ?cl\<rbrakk>\<^sub>d \<I>" using 7(1) unfolding c unlabel_def by auto
       hence "\<lbrakk>M; ?cu\<rbrakk>\<^sub>d \<I>" by (metis 0(3))
       moreover {
         fix j p k q
         assume "(j, p) \<in> ((\<lambda>(t,s). (i,t,s)) ` set F') \<union> set D"
                "(k, q) \<in> ((\<lambda>(t,s). (i,t,s)) ` set F') \<union> set D"
         hence "(j, p) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((i, NegChecks X F F')#S) \<union> set D"
               "(k, q) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((i, NegChecks X F F')#S) \<union> set D"
           by (auto simp add: setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def)
         hence "(\<exists>\<delta>. Unifier \<delta> (pair p) (pair q)) \<Longrightarrow> j = k" using prems(3) by blast
       } hence "\<forall>(j, p) \<in> ((\<lambda>(t,s). (i,t,s)) ` set F') \<union> set D.
                \<forall>(k, q) \<in> ((\<lambda>(t,s). (i,t,s)) ` set F') \<union> set D.
                 (\<exists>\<delta>. Unifier \<delta> (pair p) (pair q)) \<longrightarrow> j = k"
         by blast
       moreover have "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (map snd D) \<inter> set X = {}"
         using prems(4) by fastforce
       ultimately have "\<lbrakk>M; ?du\<rbrakk>\<^sub>d \<I>" using labeled_sat_ineq_dbproj_sem_equiv[of i] by simp
       hence "\<lbrakk>M; unlabel ?dl\<rbrakk>\<^sub>d \<I>" by (metis 0(4))
       hence "\<lbrakk>M; unlabel d\<rbrakk>\<^sub>d \<I>" using 0(2) unfolding c d unlabel_def by force
       hence 9: "\<lbrakk>M; unlabel (d@C)\<rbrakk>\<^sub>d \<I>" using 0(2) C(2) unfolding unlabel_def by auto
 
       show ?case by (metis 8 9)
     qed
   } thus "?P \<Longrightarrow> ?Q" by metis
 
   { fix C assume "C \<in> set (tr'\<^sub>p\<^sub>c A D)" "\<lbrakk>M; unlabel C\<rbrakk>\<^sub>d \<I>"
     hence ?P using assms
     proof (induction A D arbitrary: C M rule: tr'\<^sub>p\<^sub>c.induct)
       case (1 D) thus ?case by simp
     next
       case (2 i t S D)
       note prems = "2.prems"
       note IH = "2.IH"
 
       obtain C' where C': "C = (i,send\<langle>t\<rangle>\<^sub>s\<^sub>t)#C'" "C' \<in> set (tr'\<^sub>p\<^sub>c S D)"
         using prems(1) by moura
-          
+
       have 1: "\<lbrakk>M; unlabel C'\<rbrakk>\<^sub>d \<I> " using prems(2) C'(1) by simp
       have 4: "?R3 S D" using prems(3) by (auto simp add: setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def)
       have 5: "?R4 S D" using prems(4) by force
       have 6: "?R5 S D" using prems(5) by force
 
       have 7: "M \<turnstile> t \<cdot> \<I>" using prems(2) C'(1) by simp
 
       obtain B where B: "B \<in> set (tr\<^sub>p\<^sub>c S D)" "\<lbrakk>M; unlabel B\<rbrakk>\<^sub>d \<I>"
         using IH[OF C'(2) 1 4 5 6] by moura
       hence "((i,send\<langle>t\<rangle>\<^sub>s\<^sub>t)#B) \<in> set (tr\<^sub>p\<^sub>c ((i,Send t)#S) D)"
             "\<lbrakk>M; unlabel ((i,send\<langle>t\<rangle>\<^sub>s\<^sub>t)#B)\<rbrakk>\<^sub>d \<I>"
         using 7 by auto
       thus ?case by metis
     next
       case (3 i t S D)
       note prems = "3.prems"
       note IH = "3.IH"
 
       obtain C' where C': "C = (i,receive\<langle>t\<rangle>\<^sub>s\<^sub>t)#C'" "C' \<in> set (tr'\<^sub>p\<^sub>c S D)"
         using prems(1) by moura
-          
+
       have 1: "\<lbrakk>insert (t \<cdot> \<I>) M; unlabel C'\<rbrakk>\<^sub>d \<I> " using prems(2) C'(1) by simp
       have 4: "?R3 S D" using prems(3) by (auto simp add: setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def)
       have 5: "?R4 S D" using prems(4) by force
       have 6: "?R5 S D" using prems(5) by force
 
       obtain B where B: "B \<in> set (tr\<^sub>p\<^sub>c S D)" "\<lbrakk>insert (t \<cdot> \<I>) M; unlabel B\<rbrakk>\<^sub>d \<I>"
         using IH[OF C'(2) 1 4 5 6] by moura
       hence "((i,receive\<langle>t\<rangle>\<^sub>s\<^sub>t)#B) \<in> set (tr\<^sub>p\<^sub>c ((i,receive\<langle>t\<rangle>)#S) D)"
             "\<lbrakk>insert (t \<cdot> \<I>) M; unlabel ((i,receive\<langle>t\<rangle>\<^sub>s\<^sub>t)#B)\<rbrakk>\<^sub>d \<I>"
         by auto
       thus ?case by auto
     next
       case (4 i ac t t' S D)
       note prems = "4.prems"
       note IH = "4.IH"
 
       obtain C' where C': "C = (i,\<langle>ac: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t)#C'" "C' \<in> set (tr'\<^sub>p\<^sub>c S D)"
         using prems(1) by moura
-          
+
       have 1: "\<lbrakk>M; unlabel C'\<rbrakk>\<^sub>d \<I> " using prems(2) C'(1) by simp
       have 4: "?R3 S D" using prems(3) by (auto simp add: setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def)
       have 5: "?R4 S D" using prems(4) by force
       have 6: "?R5 S D" using prems(5) by force
 
       have 7: "t \<cdot> \<I> = t' \<cdot> \<I>" using prems(2) C'(1) by simp
 
       obtain B where B: "B \<in> set (tr\<^sub>p\<^sub>c S D)" "\<lbrakk>M; unlabel B\<rbrakk>\<^sub>d \<I>"
         using IH[OF C'(2) 1 4 5 6] by moura
       hence "((i,\<langle>ac: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t)#B) \<in> set (tr\<^sub>p\<^sub>c ((i,Equality ac t t')#S) D)"
             "\<lbrakk>M; unlabel ((i,\<langle>ac: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t)#B)\<rbrakk>\<^sub>d \<I>"
         using 7 by auto
       thus ?case by metis
     next
       case (5 i t s S D)
       note prems = "5.prems"
       note IH = "5.IH"
 
       have C: "C \<in> set (tr'\<^sub>p\<^sub>c S (List.insert (i,t,s) D))" using prems(1) by simp
-          
+
       have 1: "\<lbrakk>M; unlabel C\<rbrakk>\<^sub>d \<I> " using prems(2) C(1) by simp
       have 4: "?R3 S (List.insert (i,t,s) D)" using prems(3) by (auto simp add: setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def)
       have 5: "?R4 S (List.insert (i,t,s) D)" using prems(4,5) by force
       have 6: "?R5 S (List.insert (i,t,s) D)" using prems(5) by force
 
       show ?case using IH[OF C(1) 1 4 5 6] by simp
     next
       case (6 i t s S D)
       note prems = "6.prems"
       note IH = "6.IH"
 
       let ?dl1 = "\<lambda>Di. map (\<lambda>d. (i,\<langle>check: (pair (t,s)) \<doteq> (pair (snd d))\<rangle>\<^sub>s\<^sub>t)) Di"
       let ?du1 = "\<lambda>Di. map (\<lambda>d. \<langle>check: (pair (t,s)) \<doteq> (pair (snd d))\<rangle>\<^sub>s\<^sub>t) Di"
       let ?dl2 = "\<lambda>Di. map (\<lambda>d. (i,\<forall>[]\<langle>\<or>\<noteq>: [(pair (t,s), pair (snd d))]\<rangle>\<^sub>s\<^sub>t)) [d\<leftarrow>dbproj i D. d\<notin>set Di]"
       let ?du2 = "\<lambda>Di. map (\<lambda>d. \<forall>[]\<langle>\<or>\<noteq>: [(pair (t,s), pair (snd d))]\<rangle>\<^sub>s\<^sub>t) [d\<leftarrow>dbproj i D. d\<notin>set Di]"
 
       let ?cl1 = "\<lambda>Di. map (\<lambda>d. (i,\<langle>check: (pair (t,s)) \<doteq> (pair (snd d))\<rangle>\<^sub>s\<^sub>t)) Di"
       let ?cu1 = "\<lambda>Di. map (\<lambda>d. \<langle>check: (pair (t,s)) \<doteq> (pair (snd d))\<rangle>\<^sub>s\<^sub>t) Di"
       let ?cl2 = "\<lambda>Di. map (\<lambda>d. (i,\<forall>[]\<langle>\<or>\<noteq>: [(pair (t,s), pair (snd d))]\<rangle>\<^sub>s\<^sub>t)) [d\<leftarrow>D. d\<notin>set Di]"
       let ?cu2 = "\<lambda>Di. map (\<lambda>d. \<forall>[]\<langle>\<or>\<noteq>: [(pair (t,s), pair (snd d))]\<rangle>\<^sub>s\<^sub>t) [d\<leftarrow>D. d\<notin>set Di]"
 
       define c where c: "c = (\<lambda>Di. ?cl1 Di@?cl2 Di)"
       define d where d: "d = (\<lambda>Di. ?dl1 Di@?dl2 Di)"
 
       obtain C' Di where C':
           "Di \<in> set (subseqs D)" "C = c Di@C'" "C' \<in> set (tr'\<^sub>p\<^sub>c S [d\<leftarrow>D. d \<notin> set Di])"
         using prems(1) c by moura
 
       have 0: "ik\<^sub>s\<^sub>t (unlabel (c Di)) = {}" "ik\<^sub>s\<^sub>t (unlabel (d Di)) = {}"
               "unlabel (?cl1 Di) = ?cu1 Di" "unlabel (?cl2 Di) = ?cu2 Di"
               "unlabel (?dl1 Di) = ?du1 Di" "unlabel (?dl2 Di) = ?du2 Di"
         unfolding c d unlabel_def by force+
 
       have 1: "\<lbrakk>M; unlabel C'\<rbrakk>\<^sub>d \<I> " using prems(2) C'(2) 0(1) unfolding unlabel_def by auto
 
       { fix j p k q
         assume "(j, p) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \<union> set [d\<leftarrow>D. d \<notin> set Di]"
                "(k, q) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \<union> set [d\<leftarrow>D. d \<notin> set Di]"
         hence "(j, p) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((i, delete\<langle>t,s\<rangle>)#S) \<union> set D"
               "(k, q) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((i, delete\<langle>t,s\<rangle>)#S) \<union> set D"
           by (auto simp add: setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def)
         hence "(\<exists>\<delta>. Unifier \<delta> (pair p) (pair q)) \<Longrightarrow> j = k" using prems(3) by blast
       } hence 4: "?R3 S [d\<leftarrow>D. d \<notin> set Di]" by blast
 
       have 5: "?R4 S (filter (\<lambda>d. d \<notin> set Di) D)" using prems(4) by force
       have 6: "?R5 S D" using prems(5) by force
 
       obtain B where B: "B \<in> set (tr\<^sub>p\<^sub>c S [d\<leftarrow>D. d \<notin> set Di])" "\<lbrakk>M; unlabel B\<rbrakk>\<^sub>d \<I>"
         using IH[OF C'(1,3) 1 4 5 6] by moura
 
       have 7: "\<lbrakk>M; unlabel (c Di)\<rbrakk>\<^sub>d \<I>" "\<lbrakk>M; unlabel C'\<rbrakk>\<^sub>d \<I>"
         using prems(2) C'(2) 0(1) strand_sem_split(3,4)[of M "unlabel (c Di)" "unlabel C'"]
         unfolding c unlabel_def by auto
 
       { fix j p k q
         assume "(j, p) \<in> {(i, t, s)} \<union> set D"
                "(k, q) \<in> {(i, t, s)} \<union> set D"
         hence "(j, p) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((i, delete\<langle>t,s\<rangle>)#S) \<union> set D"
               "(k, q) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((i, delete\<langle>t,s\<rangle>)#S) \<union> set D"
           by (auto simp add: setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def)
         hence "(\<exists>\<delta>. Unifier \<delta> (pair p) (pair q)) \<Longrightarrow> j = k" using prems(3) by blast
       } hence "\<forall>(j, p) \<in> {(i, t, s)} \<union> set D.
                \<forall>(k, q) \<in> {(i, t, s)} \<union> set D.
                 (\<exists>\<delta>. Unifier \<delta> (pair p) (pair q)) \<longrightarrow> j = k"
         by blast
-      moreover have "\<lbrakk>M; unlabel (?cl1 Di)\<rbrakk>\<^sub>d \<I>" using 7(1) unfolding c unlabel_append by auto 
+      moreover have "\<lbrakk>M; unlabel (?cl1 Di)\<rbrakk>\<^sub>d \<I>" using 7(1) unfolding c unlabel_append by auto
       hence "\<lbrakk>M; ?cu1 Di\<rbrakk>\<^sub>d \<I>" by (metis 0(3))
       ultimately have *: "Di \<in> set (subseqs (dbproj i D))"
         using labeled_sat_eqs_subseqs[OF C'(1)] by simp
       hence 8: "d Di@B \<in> set (tr\<^sub>p\<^sub>c ((i,delete\<langle>t,s\<rangle>)#S) D)"
         using B(1) unfolding d unlabel_def by auto
 
-      have "\<lbrakk>M; unlabel (?cl2 Di)\<rbrakk>\<^sub>d \<I>" using 7(1) 0(1) unfolding c unlabel_def by auto 
+      have "\<lbrakk>M; unlabel (?cl2 Di)\<rbrakk>\<^sub>d \<I>" using 7(1) 0(1) unfolding c unlabel_def by auto
       hence "\<lbrakk>M; ?cu2 Di\<rbrakk>\<^sub>d \<I>" by (metis 0(4))
       hence "\<lbrakk>M; ?du2 Di\<rbrakk>\<^sub>d \<I>" by (metis labeled_sat_ineq_dbproj)
       hence "\<lbrakk>M; unlabel (?dl2 Di)\<rbrakk>\<^sub>d \<I>" by (metis 0(6))
-      moreover have "\<lbrakk>M; unlabel (?cl1 Di)\<rbrakk>\<^sub>d \<I>" using 7(1) unfolding c unlabel_def by auto 
+      moreover have "\<lbrakk>M; unlabel (?cl1 Di)\<rbrakk>\<^sub>d \<I>" using 7(1) unfolding c unlabel_def by auto
       hence "\<lbrakk>M; unlabel (?dl1 Di)\<rbrakk>\<^sub>d \<I>" by (metis 0(3,5))
       ultimately have "\<lbrakk>M; unlabel (d Di)\<rbrakk>\<^sub>d \<I>" using 0(2) unfolding c d unlabel_def by force
       hence 9: "\<lbrakk>M; unlabel (d Di@B)\<rbrakk>\<^sub>d \<I>" using 0(2) B(2) unfolding unlabel_def by auto
 
       show ?case by (metis 8 9)
     next
       case (7 i ac t s S D)
       note prems = "7.prems"
       note IH = "7.IH"
 
       obtain C' d where C':
           "C = (i,\<langle>ac: (pair (t,s)) \<doteq> (pair (snd d))\<rangle>\<^sub>s\<^sub>t)#C'"
           "C' \<in> set (tr'\<^sub>p\<^sub>c S D)" "d \<in> set D"
         using prems(1) by moura
-          
+
       have 1: "\<lbrakk>M; unlabel C'\<rbrakk>\<^sub>d \<I> " using prems(2) C'(1) by simp
 
       { fix j p k q
         assume "(j,p) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \<union> set D"
                "(k,q) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \<union> set D"
         hence "(j,p) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((i, InSet ac t s)#S) \<union> set D"
               "(k,q) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((i, InSet ac t s)#S) \<union> set D"
           by (auto simp add: setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def)
         hence "(\<exists>\<delta>. Unifier \<delta> (pair p) (pair q)) \<Longrightarrow> j = k" using prems(3) by blast
       } hence 4: "?R3 S D" by blast
 
       have 5: "?R4 S D" using prems(4) by force
       have 6: "?R5 S D" using prems(5) by force
 
       obtain B where B: "B \<in> set (tr\<^sub>p\<^sub>c S D)" "\<lbrakk>M; unlabel B\<rbrakk>\<^sub>d \<I>"
         using IH[OF C'(2) 1 4 5 6] by moura
 
       have 7: "pair (t,s) \<cdot> \<I> = pair (snd d) \<cdot> \<I>" using prems(2) C'(1) by simp
 
       have "(i,t,s) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((i, InSet ac t s)#S) \<union> set D"
            "(fst d, snd d) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((i, InSet ac t s)#S) \<union> set D"
         using C'(3) by (auto simp add: setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def)
       hence "\<exists>\<delta>. Unifier \<delta> (pair (t,s)) (pair (snd d)) \<Longrightarrow> i = fst d"
         using prems(3) by blast
       hence "fst d = i" using 7 by auto
       hence 8: "d \<in> set (dbproj i D)" using C'(3) by auto
 
       have 9: "((i,\<langle>ac: (pair (t,s)) \<doteq> (pair (snd d))\<rangle>\<^sub>s\<^sub>t)#B) \<in> set (tr\<^sub>p\<^sub>c ((i,InSet ac t s)#S) D)"
         using B 8 by auto
       have 10: "\<lbrakk>M; unlabel ((i,\<langle>ac: (pair (t,s)) \<doteq> (pair (snd d))\<rangle>\<^sub>s\<^sub>t)#B)\<rbrakk>\<^sub>d \<I>"
         using B 7 8 by auto
 
       show ?case by (metis 9 10)
     next
       case (8 i X F F' S D)
       note prems = "8.prems"
       note IH = "8.IH"
 
       let ?dl = "map (\<lambda>G. (i,\<forall>X\<langle>\<or>\<noteq>: (F@G)\<rangle>\<^sub>s\<^sub>t)) (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' (map snd (dbproj i D)))"
       let ?du = "map (\<lambda>G. \<forall>X\<langle>\<or>\<noteq>: (F@G)\<rangle>\<^sub>s\<^sub>t) (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' (map snd (dbproj i D)))"
 
       let ?cl = "map (\<lambda>G. (i,\<forall>X\<langle>\<or>\<noteq>: (F@G)\<rangle>\<^sub>s\<^sub>t)) (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' (map snd D))"
       let ?cu = "map (\<lambda>G. \<forall>X\<langle>\<or>\<noteq>: (F@G)\<rangle>\<^sub>s\<^sub>t) (tr\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F' (map snd D))"
 
       define c where c: "c = ?cl"
       define d where d: "d = ?dl"
 
       obtain C' where C': "C = c@C'" "C' \<in> set (tr'\<^sub>p\<^sub>c S D)" using prems(1) c by moura
 
       have 0: "ik\<^sub>s\<^sub>t (unlabel c) = {}" "ik\<^sub>s\<^sub>t (unlabel d) = {}"
-              "unlabel ?cl = ?cu" "unlabel ?dl = ?du" 
+              "unlabel ?cl = ?cu" "unlabel ?dl = ?du"
         unfolding c d unlabel_def by force+
 
       have "ik\<^sub>s\<^sub>t (unlabel c) = {}" unfolding c unlabel_def by force
       hence 1: "\<lbrakk>M; unlabel C'\<rbrakk>\<^sub>d \<I> " using prems(2) C'(1) unfolding unlabel_def by auto
 
       have "setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t S \<subseteq> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((i, NegChecks X F F')#S)" by (auto simp add: setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def)
       hence 4: "?R3 S D" using prems(3) by blast
 
       have 5: "?R4 S D" using prems(4) by force
       have 6: "?R5 S D" using prems(5) by force
 
       obtain B where B: "B \<in> set (tr\<^sub>p\<^sub>c S D)" "\<lbrakk>M; unlabel B\<rbrakk>\<^sub>d \<I>"
         using IH[OF C'(2) 1 4 5 6] by moura
 
       have 7: "\<lbrakk>M; unlabel c\<rbrakk>\<^sub>d \<I>" "\<lbrakk>M; unlabel C'\<rbrakk>\<^sub>d \<I>"
         using prems(2) C'(1) 0(1) strand_sem_split(3,4)[of M "unlabel c" "unlabel C'"]
         unfolding c unlabel_def by auto
 
       have 8: "d@B \<in> set (tr\<^sub>p\<^sub>c ((i,NegChecks X F F')#S) D)"
         using B(1) unfolding d unlabel_def by auto
 
-      have "\<lbrakk>M; unlabel ?cl\<rbrakk>\<^sub>d \<I>" using 7(1) unfolding c unlabel_def by auto 
+      have "\<lbrakk>M; unlabel ?cl\<rbrakk>\<^sub>d \<I>" using 7(1) unfolding c unlabel_def by auto
       hence "\<lbrakk>M; ?cu\<rbrakk>\<^sub>d \<I>" by (metis 0(3))
       moreover {
         fix j p k q
         assume "(j, p) \<in> ((\<lambda>(t,s). (i,t,s)) ` set F') \<union> set D"
                "(k, q) \<in> ((\<lambda>(t,s). (i,t,s)) ` set F') \<union> set D"
         hence "(j, p) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((i, NegChecks X F F')#S) \<union> set D"
               "(k, q) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t ((i, NegChecks X F F')#S) \<union> set D"
           by (auto simp add: setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def)
         hence "(\<exists>\<delta>. Unifier \<delta> (pair p) (pair q)) \<Longrightarrow> j = k" using prems(3) by blast
       } hence "\<forall>(j, p) \<in> ((\<lambda>(t,s). (i,t,s)) ` set F') \<union> set D.
                \<forall>(k, q) \<in> ((\<lambda>(t,s). (i,t,s)) ` set F') \<union> set D.
                 (\<exists>\<delta>. Unifier \<delta> (pair p) (pair q)) \<longrightarrow> j = k"
         by blast
       moreover have "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (map snd D) \<inter> set X = {}"
         using prems(4) by fastforce
       ultimately have "\<lbrakk>M; ?du\<rbrakk>\<^sub>d \<I>" using labeled_sat_ineq_dbproj_sem_equiv[of i] by simp
       hence "\<lbrakk>M; unlabel ?dl\<rbrakk>\<^sub>d \<I>" by (metis 0(4))
       hence "\<lbrakk>M; unlabel d\<rbrakk>\<^sub>d \<I>" using 0(2) unfolding c d unlabel_def by force
       hence 9: "\<lbrakk>M; unlabel (d@B)\<rbrakk>\<^sub>d \<I>" using 0(2) B(2) unfolding unlabel_def by auto
 
       show ?case by (metis 8 9)
     qed
   } thus "?Q \<Longrightarrow> ?P" by metis
 qed
 
 
 subsubsection \<open>Part 3\<close>
 private lemma tr'_par_sem_equiv:
   assumes "\<forall>(l,t,s) \<in> set D. (fv t \<union> fv s) \<inter> bvars\<^sub>s\<^sub>s\<^sub>t (unlabel A) = {}"
   and "fv\<^sub>s\<^sub>s\<^sub>t (unlabel A) \<inter> bvars\<^sub>s\<^sub>s\<^sub>t (unlabel A) = {}" "ground M"
   and "\<forall>(i,p) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<union> set D. \<forall>(j,q) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<union> set D.
         (\<exists>\<delta>. Unifier \<delta> (pair p) (pair q)) \<longrightarrow> i = j" (is "?R A D")
   and \<I>: "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>"
   shows "\<lbrakk>M; set (unlabel D) \<cdot>\<^sub>p\<^sub>s\<^sub>e\<^sub>t \<I>; unlabel A\<rbrakk>\<^sub>s \<I> \<longleftrightarrow> (\<exists>B \<in> set (tr'\<^sub>p\<^sub>c A D). \<lbrakk>M; unlabel B\<rbrakk>\<^sub>d \<I>)"
         (is "?P \<longleftrightarrow> ?Q")
 proof -
   have 1: "\<forall>(t,s) \<in> set (unlabel D). (fv t \<union> fv s) \<inter> bvars\<^sub>s\<^sub>s\<^sub>t (unlabel A) = {}"
     using assms(1) unfolding unlabel_def by force
 
   have 2: "\<forall>(i,p) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<union> set D. \<forall>(j,q) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<union> set D. p = q \<longrightarrow> i = j"
     using assms(4) subst_apply_term_empty by blast
 
   show ?thesis by (metis tr_sem_equiv'[OF 1 assms(2,3) \<I>] tr'_par_iff_unlabel_tr[OF 2])
 qed
 
 
 subsubsection \<open>Part 4\<close>
 lemma tr_par_sem_equiv:
   assumes "\<forall>(l,t,s) \<in> set D. (fv t \<union> fv s) \<inter> bvars\<^sub>s\<^sub>s\<^sub>t (unlabel A) = {}"
   and "fv\<^sub>s\<^sub>s\<^sub>t (unlabel A) \<inter> bvars\<^sub>s\<^sub>s\<^sub>t (unlabel A) = {}" "ground M"
   and "\<forall>(i,p) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<union> set D. \<forall>(j,q) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<union> set D.
         (\<exists>\<delta>. Unifier \<delta> (pair p) (pair q)) \<longrightarrow> i = j"
   and \<I>: "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>"
   shows "\<lbrakk>M; set (unlabel D) \<cdot>\<^sub>p\<^sub>s\<^sub>e\<^sub>t \<I>; unlabel A\<rbrakk>\<^sub>s \<I> \<longleftrightarrow> (\<exists>B \<in> set (tr\<^sub>p\<^sub>c A D). \<lbrakk>M; unlabel B\<rbrakk>\<^sub>d \<I>)"
   (is "?P \<longleftrightarrow> ?Q")
 using tr_par_iff_tr'_par[OF assms(4,1,2), of M \<I>] tr'_par_sem_equiv[OF assms] by metis
 
 end
 
 
 subsection \<open>Theorem: The Stateful Compositionality Result, on the Constraint Level\<close>
 theorem par_comp_constr_stateful:
   assumes \<A>: "par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> Sec" "typing_cond\<^sub>s\<^sub>s\<^sub>t (unlabel \<A>)"
   and \<I>: "\<I> \<Turnstile>\<^sub>s unlabel \<A>" "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>"
   shows "\<exists>\<I>\<^sub>\<tau>. interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>\<^sub>\<tau> \<and> wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>\<^sub>\<tau> \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<I>\<^sub>\<tau>) \<and> (\<I>\<^sub>\<tau> \<Turnstile>\<^sub>s unlabel \<A>) \<and>
               ((\<forall>n. \<I>\<^sub>\<tau> \<Turnstile>\<^sub>s proj_unl n \<A>) \<or> (\<exists>\<A>'. prefix \<A>' \<A> \<and> (\<A>' leaks Sec under \<I>\<^sub>\<tau>)))"
 proof -
   let ?P = "\<lambda>n A D.
        \<forall>(i, p) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t (proj n A) \<union> set D.
        \<forall>(j, q) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t (proj n A) \<union> set D.
           (\<exists>\<delta>. Unifier \<delta> (pair p) (pair q)) \<longrightarrow> i = j"
 
   have 1: "\<forall>(l, t, t')\<in>set []. (fv t \<union> fv t') \<inter> bvars\<^sub>s\<^sub>s\<^sub>t (unlabel \<A>) = {}"
           "fv\<^sub>s\<^sub>s\<^sub>t (unlabel \<A>) \<inter> bvars\<^sub>s\<^sub>s\<^sub>t (unlabel \<A>) = {}" "ground {}"
     using \<A>(2) unfolding typing_cond\<^sub>s\<^sub>s\<^sub>t_def by simp_all
 
   have 2: "\<And>n. \<forall>(l, t, t')\<in>set []. (fv t \<union> fv t') \<inter> bvars\<^sub>s\<^sub>s\<^sub>t (proj_unl n \<A>) = {}"
           "\<And>n. fv\<^sub>s\<^sub>s\<^sub>t (proj_unl n \<A>) \<inter> bvars\<^sub>s\<^sub>s\<^sub>t (proj_unl n \<A>) = {}"
     using 1(1,2) sst_vars_proj_subset[of _ \<A>] by fast+
 
   have 3: "\<And>n. par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t (proj n \<A>) Sec"
     using par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_proj[OF \<A>(1)] by metis
 
   have 4:
       "\<lbrakk>{}; set (unlabel []) \<cdot>\<^sub>p\<^sub>s\<^sub>e\<^sub>t \<I>'; unlabel \<A>\<rbrakk>\<^sub>s \<I>' \<longleftrightarrow>
         (\<exists>B\<in>set (tr\<^sub>p\<^sub>c \<A> []). \<lbrakk>{}; unlabel B\<rbrakk>\<^sub>d \<I>')"
     when \<I>': "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>'" for \<I>'
     using tr_par_sem_equiv[OF 1 _ \<I>'] \<A>(1)
     unfolding par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def constr_sem_d_def by auto
 
   obtain \<A>' where \<A>': "\<A>' \<in> set (tr\<^sub>p\<^sub>c \<A> [])" "\<I> \<Turnstile> \<langle>unlabel \<A>'\<rangle>"
     using 4[OF \<I>(2)] \<I>(1) unfolding constr_sem_d_def by moura
 
   obtain \<I>\<^sub>\<tau> where \<I>\<^sub>\<tau>:
       "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>\<^sub>\<tau>" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>\<^sub>\<tau>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<I>\<^sub>\<tau>)" "\<I>\<^sub>\<tau> \<Turnstile> \<langle>unlabel \<A>'\<rangle>"
       "(\<forall>n. (\<I>\<^sub>\<tau> \<Turnstile> \<langle>proj_unl n \<A>'\<rangle>)) \<or> (\<exists>\<A>''. prefix \<A>'' \<A>' \<and> (strand_leaks\<^sub>l\<^sub>s\<^sub>t \<A>'' Sec \<I>\<^sub>\<tau>))"
     using par_comp_constr[OF tr_par_preserves_par_comp[OF \<A>(1) \<A>'(1)]
                              tr_par_preserves_typing_cond[OF \<A> \<A>'(1)]
                              \<A>'(2) \<I>(2)]
     by moura
 
   have \<I>\<^sub>\<tau>': "\<I>\<^sub>\<tau> \<Turnstile>\<^sub>s unlabel \<A>" using 4[OF \<I>\<^sub>\<tau>(1)] \<A>'(1) \<I>\<^sub>\<tau>(4) unfolding constr_sem_d_def by auto
 
   show ?thesis
   proof (cases "\<forall>n. (\<I>\<^sub>\<tau> \<Turnstile> \<langle>proj_unl n \<A>'\<rangle>)")
     case True
     { fix n assume "\<I>\<^sub>\<tau> \<Turnstile> \<langle>proj_unl n \<A>'\<rangle>"
       hence "\<lbrakk>{}; {}; unlabel (proj n \<A>)\<rbrakk>\<^sub>s \<I>\<^sub>\<tau>"
         using tr_par_proj[OF \<A>'(1), of n]
               tr_par_sem_equiv[OF 2(1,2) 1(3) _ \<I>\<^sub>\<tau>(1), of n] 3(1)
         unfolding par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def proj_def constr_sem_d_def by force
     } thus ?thesis using True \<I>\<^sub>\<tau>(1,2,3) \<I>\<^sub>\<tau>' by metis
   next
     case False
     then obtain \<A>''::"('fun,'var,'lbl) labeled_strand" where \<A>'':
         "prefix \<A>'' \<A>'" "strand_leaks\<^sub>l\<^sub>s\<^sub>t \<A>'' Sec \<I>\<^sub>\<tau>"
       using \<I>\<^sub>\<tau> by blast
     moreover {
       fix t l assume *: "\<lbrakk>{}; unlabel (proj l \<A>'')@[send\<langle>t\<rangle>\<^sub>s\<^sub>t]\<rbrakk>\<^sub>d \<I>\<^sub>\<tau>"
       have "\<I>\<^sub>\<tau> \<Turnstile> \<langle>unlabel (proj l \<A>'')\<rangle>" "ik\<^sub>s\<^sub>t (unlabel (proj l \<A>'')) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>\<^sub>\<tau> \<turnstile> t \<cdot> \<I>\<^sub>\<tau>"
         using strand_sem_split(3,4)[OF *] unfolding constr_sem_d_def by auto
     } ultimately have "\<exists>t \<in> Sec - declassified\<^sub>l\<^sub>s\<^sub>t \<A>'' \<I>\<^sub>\<tau>. \<exists>l.
             (\<I>\<^sub>\<tau> \<Turnstile> \<langle>unlabel (proj l \<A>'')\<rangle>) \<and> ik\<^sub>s\<^sub>t (unlabel (proj l \<A>'')) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>\<^sub>\<tau> \<turnstile> t \<cdot> \<I>\<^sub>\<tau>"
       unfolding strand_leaks\<^sub>l\<^sub>s\<^sub>t_def constr_sem_d_def by metis
     then obtain s m where sm:
         "s \<in> Sec - declassified\<^sub>l\<^sub>s\<^sub>t \<A>'' \<I>\<^sub>\<tau>"
         "\<I>\<^sub>\<tau> \<Turnstile> \<langle>unlabel (proj m \<A>'')\<rangle>"
         "ik\<^sub>s\<^sub>t (unlabel (proj m \<A>'')) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>\<^sub>\<tau> \<turnstile> s \<cdot> \<I>\<^sub>\<tau>"
       by moura
 
     \<comment> \<open>
       We now need to show that there is some prefix \<open>B\<close> of \<open>\<A>''\<close> that also leaks
       and where \<open>B \<in> set (tr C D)\<close> for some prefix \<open>C\<close> of \<open>\<A>\<close>
     \<close>
     obtain B::"('fun,'var,'lbl) labeled_strand"
         and C::"('fun,'var,'lbl) labeled_stateful_strand"
       where BC:
         "prefix B \<A>'" "prefix C \<A>" "B \<in> set (tr\<^sub>p\<^sub>c C [])"
         "ik\<^sub>s\<^sub>t (unlabel (proj m B)) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>\<^sub>\<tau> \<turnstile> s \<cdot> \<I>\<^sub>\<tau>"
         "prefix B \<A>''"
       using tr_leaking_prefix_exists[OF \<A>'(1) \<A>''(1) sm(3)] prefix_order.order_trans[OF _ \<A>''(1)]
       by auto
     have "\<lbrakk>{}; unlabel (proj m B)\<rbrakk>\<^sub>d \<I>\<^sub>\<tau>"
       using sm(2) BC(5) unfolding prefix_def unlabel_def proj_def constr_sem_d_def by auto
     hence BC': "\<I>\<^sub>\<tau> \<Turnstile> \<langle>proj_unl m B@[send\<langle>s\<rangle>\<^sub>s\<^sub>t]\<rangle>"
       using BC(4) unfolding constr_sem_d_def by auto
     have BC'': "s \<in> Sec - declassified\<^sub>l\<^sub>s\<^sub>t B \<I>\<^sub>\<tau>"
       using BC(5) sm(1) unfolding prefix_def declassified\<^sub>l\<^sub>s\<^sub>t_def by auto
     have 5: "par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t (proj n C) Sec" for n
       using \<A>(1) BC(2) par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_split(1)[THEN par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_proj]
       unfolding prefix_def by auto
     have "fv\<^sub>s\<^sub>s\<^sub>t (unlabel \<A>) \<inter> bvars\<^sub>s\<^sub>s\<^sub>t (unlabel \<A>) = {}"
          "fv\<^sub>s\<^sub>s\<^sub>t (unlabel C) \<subseteq> fv\<^sub>s\<^sub>s\<^sub>t (unlabel \<A>)"
          "bvars\<^sub>s\<^sub>s\<^sub>t (unlabel C) \<subseteq> bvars\<^sub>s\<^sub>s\<^sub>t (unlabel \<A>)"
       using \<A>(2) BC(2) sst_vars_append_subset(1,2)[of "unlabel C"]
       unfolding typing_cond\<^sub>s\<^sub>s\<^sub>t_def prefix_def unlabel_def by auto
     hence "fv\<^sub>s\<^sub>s\<^sub>t (proj_unl n C) \<inter> bvars\<^sub>s\<^sub>s\<^sub>t (proj_unl n C) = {}" for n
       using sst_vars_proj_subset[of _ C] sst_vars_proj_subset[of _ \<A>]
       by blast
     hence 6:
         "\<forall>(l, t, t')\<in>set []. (fv t \<union> fv t') \<inter> bvars\<^sub>s\<^sub>s\<^sub>t (proj_unl n C) = {}"
         "fv\<^sub>s\<^sub>s\<^sub>t (proj_unl n C) \<inter> bvars\<^sub>s\<^sub>s\<^sub>t (proj_unl n C) = {}"
         "ground {}"
       for n
       using 2 by auto
     have 7: "?P n C []" for n using 5 unfolding par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by simp
     have "s \<cdot> \<I>\<^sub>\<tau> = s" using \<I>\<^sub>\<tau>(1) BC'' \<A>(1) unfolding par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by auto
     hence "\<exists>n. (\<I>\<^sub>\<tau> \<Turnstile>\<^sub>s proj_unl n C) \<and> ik\<^sub>s\<^sub>s\<^sub>t (proj_unl n C) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>\<^sub>\<tau> \<turnstile> s \<cdot> \<I>\<^sub>\<tau>"
       using tr_par_proj[OF BC(3), of m] BC'(1)
             tr_par_sem_equiv[OF 6 7 \<I>\<^sub>\<tau>(1), of m]
             tr_par_deduct_iff[OF tr_par_proj(1)[OF BC(3)], of \<I>\<^sub>\<tau> m s]
       unfolding proj_def constr_sem_d_def by auto
     hence "\<exists>n. \<I>\<^sub>\<tau> \<Turnstile>\<^sub>s (proj_unl n C@[Send s])" using strand_sem_append_stateful by simp
     moreover have "s \<in> Sec - declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t C \<I>\<^sub>\<tau>" by (metis tr_par_declassified_eq BC(3) BC'')
     ultimately show ?thesis using \<I>\<^sub>\<tau>(1,2,3) \<I>\<^sub>\<tau>' BC(2) unfolding strand_leaks\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by metis
   qed
 qed
 
 
 subsection \<open>Theorem: The Stateful Compositionality Result, on the Protocol Level\<close>
 abbreviation wf\<^sub>l\<^sub>s\<^sub>s\<^sub>t where
   "wf\<^sub>l\<^sub>s\<^sub>s\<^sub>t V \<A> \<equiv> wf'\<^sub>s\<^sub>s\<^sub>t V (unlabel \<A>)"
 
 text \<open>
   We state our result on the level of protocol traces (i.e., the constraints reachable in a
   symbolic execution of the actual protocol). Hence, we do not need to convert protocol strands
   to intruder constraints in the following well-formedness definitions.
 \<close>
 definition wf\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>s::"('fun,'var,'lbl) labeled_stateful_strand set \<Rightarrow> bool" where
   "wf\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>s \<S> \<equiv> (\<forall>\<A> \<in> \<S>. wf\<^sub>l\<^sub>s\<^sub>s\<^sub>t {} \<A>) \<and> (\<forall>\<A> \<in> \<S>. \<forall>\<A>' \<in> \<S>. fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<inter> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>' = {})"
 
 definition wf\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>s'::
   "('fun,'var,'lbl) labeled_stateful_strand set \<Rightarrow> ('fun,'var,'lbl) labeled_stateful_strand \<Rightarrow> bool"
 where
   "wf\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>s' \<S> \<A> \<equiv> (\<forall>\<A>' \<in> \<S>. wf'\<^sub>s\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>) (unlabel \<A>')) \<and>
                  (\<forall>\<A>' \<in> \<S>. \<forall>\<A>'' \<in> \<S>. fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>' \<inter> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>'' = {}) \<and>
                  (\<forall>\<A>' \<in> \<S>. fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>' \<inter> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> = {}) \<and>
                  (\<forall>\<A>' \<in> \<S>. fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<inter> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>' = {})"
 
 definition typing_cond_prot_stateful where
   "typing_cond_prot_stateful \<P> \<equiv>
     wf\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>s \<P> \<and>
     tfr\<^sub>s\<^sub>e\<^sub>t (\<Union>(trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t ` \<P>) \<union> pair ` \<Union>(setops\<^sub>s\<^sub>s\<^sub>t ` unlabel ` \<P>)) \<and>
     wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (\<Union>(trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t ` \<P>)) \<and>
     (\<forall>S \<in> \<P>. list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (unlabel S))"
 
 definition par_comp_prot_stateful where
   "par_comp_prot_stateful \<P> Sec \<equiv>
     (\<forall>l1 l2. l1 \<noteq> l2 \<longrightarrow>
       GSMP_disjoint (\<Union>\<A> \<in> \<P>. trms\<^sub>s\<^sub>s\<^sub>t (proj_unl l1 \<A>) \<union> pair ` setops\<^sub>s\<^sub>s\<^sub>t (proj_unl l1 \<A>))
                     (\<Union>\<A> \<in> \<P>. trms\<^sub>s\<^sub>s\<^sub>t (proj_unl l2 \<A>) \<union> pair ` setops\<^sub>s\<^sub>s\<^sub>t (proj_unl l2 \<A>)) Sec) \<and>
     ground Sec \<and> (\<forall>s \<in> Sec. \<forall>s' \<in> subterms s. {} \<turnstile>\<^sub>c s' \<or> s' \<in> Sec) \<and>
     (\<forall>(i,p) \<in> \<Union>\<A> \<in> \<P>. setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>. \<forall>(j,q) \<in> \<Union>\<A> \<in> \<P>. setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>.
       (\<exists>\<delta>. Unifier \<delta> (pair p) (pair q)) \<longrightarrow> i = j) \<and>
     typing_cond_prot_stateful \<P>"
 
 definition component_secure_prot_stateful where
   "component_secure_prot_stateful n P Sec attack \<equiv>
-    (\<forall>\<A> \<in> P. suffix [(ln n, Send (Fun attack []))] \<A> \<longrightarrow> 
+    (\<forall>\<A> \<in> P. suffix [(ln n, Send (Fun attack []))] \<A> \<longrightarrow>
      (\<forall>\<I>\<^sub>\<tau>. (interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>\<^sub>\<tau> \<and> wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>\<^sub>\<tau> \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<I>\<^sub>\<tau>)) \<longrightarrow>
             \<not>(\<I>\<^sub>\<tau> \<Turnstile>\<^sub>s (proj_unl n \<A>)) \<and>
             (\<forall>\<A>'. prefix \<A>' \<A> \<longrightarrow>
                     (\<forall>t \<in> Sec-declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>' \<I>\<^sub>\<tau>. \<not>(\<I>\<^sub>\<tau> \<Turnstile>\<^sub>s (proj_unl n \<A>'@[Send t]))))))"
 
 definition component_leaks_stateful where
   "component_leaks_stateful n \<A> Sec \<equiv>
     (\<exists>\<A>' \<I>\<^sub>\<tau>. interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>\<^sub>\<tau> \<and> wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>\<^sub>\<tau> \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<I>\<^sub>\<tau>) \<and> prefix \<A>' \<A> \<and>
              (\<exists>t \<in> Sec - declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>' \<I>\<^sub>\<tau>. (\<I>\<^sub>\<tau> \<Turnstile>\<^sub>s (proj_unl n \<A>'@[Send t]))))"
 
 definition unsat_stateful where
   "unsat_stateful \<A> \<equiv> (\<forall>\<I>. interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I> \<longrightarrow> \<not>(\<I> \<Turnstile>\<^sub>s unlabel \<A>))"
 
 lemma wf\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>s_eqs_wf\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>s'[simp]: "wf\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>s S = wf\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>s' S []"
 unfolding wf\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>s_def wf\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>s'_def unlabel_def wfrestrictedvars\<^sub>s\<^sub>s\<^sub>t_def by simp
 
 lemma par_comp_prot_impl_par_comp_stateful:
   assumes "par_comp_prot_stateful \<P> Sec" "\<A> \<in> \<P>"
   shows "par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> Sec"
 proof -
-  have *: 
+  have *:
       "\<forall>l1 l2. l1 \<noteq> l2 \<longrightarrow>
           GSMP_disjoint (\<Union>\<A> \<in> \<P>. trms\<^sub>s\<^sub>s\<^sub>t (proj_unl l1 \<A>) \<union> pair ` setops\<^sub>s\<^sub>s\<^sub>t (proj_unl l1 \<A>))
                         (\<Union>\<A> \<in> \<P>. trms\<^sub>s\<^sub>s\<^sub>t (proj_unl l2 \<A>) \<union> pair ` setops\<^sub>s\<^sub>s\<^sub>t (proj_unl l2 \<A>)) Sec"
     using assms(1) unfolding par_comp_prot_stateful_def by argo
   { fix l1 l2::'lbl assume **: "l1 \<noteq> l2"
-    hence ***: 
+    hence ***:
         "GSMP_disjoint (\<Union>\<A> \<in> \<P>. trms\<^sub>s\<^sub>s\<^sub>t (proj_unl l1 \<A>) \<union> pair ` setops\<^sub>s\<^sub>s\<^sub>t (proj_unl l1 \<A>))
                        (\<Union>\<A> \<in> \<P>. trms\<^sub>s\<^sub>s\<^sub>t (proj_unl l2 \<A>) \<union> pair ` setops\<^sub>s\<^sub>s\<^sub>t (proj_unl l2 \<A>)) Sec"
       using * by auto
     have "GSMP_disjoint (trms\<^sub>s\<^sub>s\<^sub>t (proj_unl l1 \<A>) \<union> pair ` setops\<^sub>s\<^sub>s\<^sub>t (proj_unl l1 \<A>))
                         (trms\<^sub>s\<^sub>s\<^sub>t (proj_unl l2 \<A>) \<union> pair ` setops\<^sub>s\<^sub>s\<^sub>t (proj_unl l2 \<A>)) Sec"
       using GSMP_disjoint_subset[OF ***] assms(2) by auto
   } hence "\<forall>l1 l2. l1 \<noteq> l2 \<longrightarrow>
               GSMP_disjoint (trms\<^sub>s\<^sub>s\<^sub>t (proj_unl l1 \<A>) \<union> pair ` setops\<^sub>s\<^sub>s\<^sub>t (proj_unl l1 \<A>))
                             (trms\<^sub>s\<^sub>s\<^sub>t (proj_unl l2 \<A>) \<union> pair ` setops\<^sub>s\<^sub>s\<^sub>t (proj_unl l2 \<A>)) Sec"
     by metis
   moreover have "\<forall>(i,p) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>. \<forall>(j,q) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>.
                     (\<exists>\<delta>. Unifier \<delta> (pair p) (pair q)) \<longrightarrow> i = j"
     using assms(1,2) unfolding par_comp_prot_stateful_def by blast
   ultimately show ?thesis
     using assms
     unfolding par_comp_prot_stateful_def par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def
     by fast
 qed
 
 lemma typing_cond_prot_impl_typing_cond_stateful:
   assumes "typing_cond_prot_stateful \<P>" "\<A> \<in> \<P>"
   shows "typing_cond\<^sub>s\<^sub>s\<^sub>t (unlabel \<A>)"
 proof -
   have 1: "wf'\<^sub>s\<^sub>s\<^sub>t {} (unlabel \<A>)" "fv\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<inter> bvars\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> = {}"
     using assms unfolding typing_cond_prot_stateful_def wf\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>s_def by auto
 
   have "tfr\<^sub>s\<^sub>e\<^sub>t (\<Union>(trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t ` \<P>) \<union> pair ` \<Union>(setops\<^sub>s\<^sub>s\<^sub>t ` unlabel ` \<P>))"
        "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (\<Union>(trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t ` \<P>))"
        "trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<subseteq> \<Union>(trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t ` \<P>)"
        "SMP (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<union> pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel \<A>)) - Var`\<V> \<subseteq>
         SMP (\<Union>(trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t ` \<P>) \<union> pair ` \<Union>(setops\<^sub>s\<^sub>s\<^sub>t ` unlabel ` \<P>)) - Var`\<V>"
     using assms SMP_mono[of "trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<union> pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel \<A>)"
                             "\<Union>(trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t ` \<P>) \<union> pair ` \<Union>(setops\<^sub>s\<^sub>s\<^sub>t ` unlabel ` \<P>)"]
     unfolding typing_cond_prot_stateful_def
     by (metis, metis, auto)
   hence 2: "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> \<union> pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel \<A>))" and 3: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>)"
     unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def by (meson subsetD)+
 
   have 4: "list_all tfr\<^sub>s\<^sub>s\<^sub>t\<^sub>p (unlabel \<A>)" using assms unfolding typing_cond_prot_stateful_def by auto
 
   show ?thesis using 1 2 3 4 unfolding typing_cond\<^sub>s\<^sub>s\<^sub>t_def tfr\<^sub>s\<^sub>s\<^sub>t_def by blast
 qed
 
 theorem par_comp_constr_prot_stateful:
   assumes P: "P = composed_prot Pi" "par_comp_prot_stateful P Sec" "\<forall>n. component_prot n (Pi n)"
   and left_secure: "component_secure_prot_stateful n (Pi n) Sec attack"
   shows "\<forall>\<A> \<in> P. suffix [(ln n, Send (Fun attack []))] \<A> \<longrightarrow>
                   unsat_stateful \<A> \<or> (\<exists>m. n \<noteq> m \<and> component_leaks_stateful m \<A> Sec)"
 proof -
   { fix \<A> \<A>' assume \<A>: "\<A> = \<A>'@[(ln n, Send (Fun attack []))]" "\<A> \<in> P"
     let ?P = "\<exists>\<A>' \<I>\<^sub>\<tau>. interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>\<^sub>\<tau> \<and> wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>\<^sub>\<tau> \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<I>\<^sub>\<tau>) \<and> prefix \<A>' \<A> \<and>
                    (\<exists>t \<in> Sec-declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>' \<I>\<^sub>\<tau>. \<exists>m. n \<noteq> m \<and> (\<I>\<^sub>\<tau> \<Turnstile>\<^sub>s (proj_unl m \<A>'@[Send t])))"
     have tcp: "typing_cond_prot_stateful P" using P(2) unfolding par_comp_prot_stateful_def by simp
     have par_comp: "par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A> Sec" "typing_cond\<^sub>s\<^sub>s\<^sub>t (unlabel \<A>)"
       using par_comp_prot_impl_par_comp_stateful[OF P(2) \<A>(2)]
             typing_cond_prot_impl_typing_cond_stateful[OF tcp \<A>(2)]
       by metis+
-  
+
     have "unlabel (proj n \<A>) = proj_unl n \<A>" "proj_unl n \<A> = proj_unl n (proj n \<A>)"
-         "\<And>A. A \<in> Pi n \<Longrightarrow> proj n A = A" 
+         "\<And>A. A \<in> Pi n \<Longrightarrow> proj n A = A"
          "proj n \<A> = (proj n \<A>')@[(ln n, Send (Fun attack []))]"
       using P(1,3) \<A> by (auto simp add: proj_def unlabel_def component_prot_def composed_prot_def)
     moreover have "proj n \<A> \<in> Pi n"
       using P(1) \<A> unfolding composed_prot_def by blast
     moreover {
       fix A assume "prefix A \<A>"
       hence *: "prefix (proj n A) (proj n \<A>)" unfolding proj_def prefix_def by force
       hence "proj_unl n A = proj_unl n (proj n A)"
             "\<forall>I. declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t A I = declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t (proj n A) I"
         unfolding proj_def declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by auto
       hence "\<exists>B. prefix B (proj n \<A>) \<and> proj_unl n A = proj_unl n B \<and>
                  (\<forall>I. declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t A I = declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t B I)"
         using * by metis
     }
-    ultimately have *: 
+    ultimately have *:
         "\<forall>\<I>\<^sub>\<tau>. interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>\<^sub>\<tau> \<and> wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>\<^sub>\<tau> \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<I>\<^sub>\<tau>) \<longrightarrow>
                   \<not>(\<I>\<^sub>\<tau> \<Turnstile>\<^sub>s (proj_unl n \<A>)) \<and> (\<forall>\<A>'. prefix \<A>' \<A> \<longrightarrow>
                         (\<forall>t \<in> Sec - declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>' \<I>\<^sub>\<tau>. \<not>(\<I>\<^sub>\<tau> \<Turnstile>\<^sub>s (proj_unl n \<A>'@[Send t]))))"
       using left_secure
       unfolding component_secure_prot_stateful_def composed_prot_def suffix_def
       by metis
     { fix \<I> assume \<I>: "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>" "\<I> \<Turnstile>\<^sub>s unlabel \<A>"
       obtain \<I>\<^sub>\<tau> where \<I>\<^sub>\<tau>:
           "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>\<^sub>\<tau>" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>\<^sub>\<tau>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<I>\<^sub>\<tau>)"
           "\<exists>\<A>'. prefix \<A>' \<A> \<and> (\<A>' leaks Sec under \<I>\<^sub>\<tau>)"
         using par_comp_constr_stateful[OF par_comp \<I>(2,1)] * by moura
       hence "\<exists>\<A>'. prefix \<A>' \<A> \<and> (\<exists>t \<in> Sec - declassified\<^sub>l\<^sub>s\<^sub>s\<^sub>t \<A>' \<I>\<^sub>\<tau>. \<exists>m.
                   n \<noteq> m \<and> (\<I>\<^sub>\<tau> \<Turnstile>\<^sub>s (proj_unl m \<A>'@[Send t])))"
         using \<I>\<^sub>\<tau>(4) * unfolding strand_leaks\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def by metis
       hence ?P using \<I>\<^sub>\<tau>(1,2,3) by auto
     } hence "unsat_stateful \<A> \<or> (\<exists>m. n \<noteq> m \<and> component_leaks_stateful m \<A> Sec)"
       by (metis unsat_stateful_def component_leaks_stateful_def)
   } thus ?thesis unfolding suffix_def by metis
 qed
 
 end
 
 subsection \<open>Automated Compositionality Conditions\<close>
 definition comp_GSMP_disjoint where
   "comp_GSMP_disjoint public arity Ana \<Gamma> A' B' A B C \<equiv>
     let B\<delta> = B \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t var_rename (max_var_set (fv\<^sub>s\<^sub>e\<^sub>t (set A)))
     in has_all_wt_instances_of \<Gamma> (set A') (set A) \<and>
        has_all_wt_instances_of \<Gamma> (set B') (set B\<delta>) \<and>
        finite_SMP_representation arity Ana \<Gamma> A \<and>
        finite_SMP_representation arity Ana \<Gamma> B\<delta> \<and>
        (\<forall>t \<in> set A. \<forall>s \<in> set B\<delta>. \<Gamma> t = \<Gamma> s \<and> mgu t s \<noteq> None \<longrightarrow>
          (intruder_synth' public arity {} t \<and> intruder_synth' public arity {} s) \<or>
          (\<exists>u \<in> set C. is_wt_instance_of_cond \<Gamma> t u) \<and> (\<exists>u \<in> set C. is_wt_instance_of_cond \<Gamma> s u))"
 
 definition comp_par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t where
   "comp_par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t public arity Ana \<Gamma> pair_fun A M C \<equiv>
   let L = remdups (map (the_LabelN \<circ> fst) (filter (Not \<circ> is_LabelS) A));
       MP0 = \<lambda>B. remdups (trms_list\<^sub>s\<^sub>s\<^sub>t B@map (pair' pair_fun) (setops_list\<^sub>s\<^sub>s\<^sub>t B));
       pr = \<lambda>l. MP0 (proj_unl l A)
   in length L > 1 \<and>
      list_all (wf\<^sub>t\<^sub>r\<^sub>m' arity) (MP0 (unlabel A)) \<and>
      list_all (wf\<^sub>t\<^sub>r\<^sub>m' arity) C \<and>
      has_all_wt_instances_of \<Gamma> (subterms\<^sub>s\<^sub>e\<^sub>t (set C)) (set C) \<and>
      is_TComp_var_instance_closed \<Gamma> C \<and>
      (\<forall>i \<in> set L. \<forall>j \<in> set L. i \<noteq> j \<longrightarrow>
         comp_GSMP_disjoint public arity Ana \<Gamma> (pr i) (pr j) (M i) (M j) C) \<and>
      (\<forall>(i,p) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A. \<forall>(j,q) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A. i \<noteq> j \<longrightarrow>
         (let s = pair' pair_fun p; t = pair' pair_fun q
          in mgu s (t \<cdot> var_rename (max_var s)) = None))"
 
 locale labeled_stateful_typed_model' =
   stateful_typed_model' arity public Ana \<Gamma> Pair
 + labeled_typed_model' arity public Ana \<Gamma> label_witness1 label_witness2
   for arity::"'fun \<Rightarrow> nat"
   and public::"'fun \<Rightarrow> bool"
   and Ana::"('fun,(('fun,'atom::finite) term_type \<times> nat)) term
             \<Rightarrow> (('fun,(('fun,'atom) term_type \<times> nat)) term list
                \<times> ('fun,(('fun,'atom) term_type \<times> nat)) term list)"
   and \<Gamma>::"('fun,(('fun,'atom) term_type \<times> nat)) term \<Rightarrow> ('fun,'atom) term_type"
   and Pair::"'fun"
   and label_witness1::"'lbl"
   and label_witness2::"'lbl"
 begin
 
 sublocale labeled_stateful_typed_model
 by unfold_locales
 
 lemma GSMP_disjoint_if_comp_GSMP_disjoint:
   defines "f \<equiv> \<lambda>M. {t \<cdot> \<delta> | t \<delta>. t \<in> M \<and> wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta> \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>) \<and> fv (t \<cdot> \<delta>) = {}}"
   assumes AB'_wf: "list_all (wf\<^sub>t\<^sub>r\<^sub>m' arity) A'" "list_all (wf\<^sub>t\<^sub>r\<^sub>m' arity) B'"
     and C_wf: "list_all (wf\<^sub>t\<^sub>r\<^sub>m' arity) C"
     and AB'_disj: "comp_GSMP_disjoint public arity Ana \<Gamma> A' B' A B C"
   shows "GSMP_disjoint (set A') (set B') ((f (set C)) - {m. {} \<turnstile>\<^sub>c m})"
 using GSMP_disjointI[of A' B' A B] AB'_wf AB'_disj C_wf
 unfolding comp_GSMP_disjoint_def f_def wf\<^sub>t\<^sub>r\<^sub>m_code list_all_iff Let_def by fast
 
 lemma par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_if_comp_par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t:
   defines "f \<equiv> \<lambda>M. {t \<cdot> \<delta> | t \<delta>. t \<in> M \<and> wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta> \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>) \<and> fv (t \<cdot> \<delta>) = {}}"
   assumes A: "comp_par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t public arity Ana \<Gamma> Pair A M C"
   shows "par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t A ((f (set C)) - {m. {} \<turnstile>\<^sub>c m})"
 proof (unfold par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def; intro conjI)
   let ?Sec = "(f (set C)) - {m. {} \<turnstile>\<^sub>c m}"
   let ?L = "remdups (map (the_LabelN \<circ> fst) (filter (Not \<circ> is_LabelS) A))"
   let ?N1 = "\<lambda>B. remdups (trms_list\<^sub>s\<^sub>s\<^sub>t B@map (pair' Pair) (setops_list\<^sub>s\<^sub>s\<^sub>t B))"
   let ?N2 = "\<lambda>B. trms\<^sub>s\<^sub>s\<^sub>t B \<union> pair ` setops\<^sub>s\<^sub>s\<^sub>t B"
   let ?pr = "\<lambda>l. ?N1 (proj_unl l A)"
   let ?\<alpha> = "\<lambda>p. var_rename (max_var (pair p))"
 
   have 0:
       "length ?L > 1"
       "list_all (wf\<^sub>t\<^sub>r\<^sub>m' arity) (?N1 (unlabel A))"
       "list_all (wf\<^sub>t\<^sub>r\<^sub>m' arity) C"
       "has_all_wt_instances_of \<Gamma> (subterms\<^sub>s\<^sub>e\<^sub>t (set C)) (set C)"
       "is_TComp_var_instance_closed \<Gamma> C"
       "\<forall>i \<in> set ?L. \<forall>j \<in> set ?L. i \<noteq> j \<longrightarrow>
         comp_GSMP_disjoint public arity Ana \<Gamma> (?pr i) (?pr j) (M i) (M j) C"
       "\<forall>(i,p) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A. \<forall>(j,q) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A. i \<noteq> j \<longrightarrow> mgu (pair p) (pair q \<cdot> ?\<alpha> p) = None"
     using A unfolding comp_par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def pair_code by meson+
 
   have L_in_iff: "l \<in> set ?L \<longleftrightarrow> (\<exists>a \<in> set A. is_LabelN l a)" for l by force
 
   have A_wf_trms: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t A \<union> pair ` setops\<^sub>s\<^sub>s\<^sub>t (unlabel A))"
     using 0(2)
     unfolding pair_code wf\<^sub>t\<^sub>r\<^sub>m_code list_all_iff trms_list\<^sub>s\<^sub>s\<^sub>t_is_trms\<^sub>s\<^sub>s\<^sub>t setops_list\<^sub>s\<^sub>s\<^sub>t_is_setops\<^sub>s\<^sub>s\<^sub>t
     by auto
   hence A_proj_wf_trms: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>l\<^sub>s\<^sub>s\<^sub>t (proj l A) \<union> pair ` setops\<^sub>s\<^sub>s\<^sub>t (proj_unl l A))" for l
     using trms\<^sub>s\<^sub>s\<^sub>t_proj_subset(1)[of l A] setops\<^sub>s\<^sub>s\<^sub>t_proj_subset(1)[of l A] by blast
   hence A_proj_wf_trms': "list_all (wf\<^sub>t\<^sub>r\<^sub>m' arity) (?N1 (proj_unl l A))" for l
     unfolding pair_code wf\<^sub>t\<^sub>r\<^sub>m_code list_all_iff trms_list\<^sub>s\<^sub>s\<^sub>t_is_trms\<^sub>s\<^sub>s\<^sub>t setops_list\<^sub>s\<^sub>s\<^sub>t_is_setops\<^sub>s\<^sub>s\<^sub>t
     by auto
 
   note C_wf_trms = 0(3)[unfolded list_all_iff wf\<^sub>t\<^sub>r\<^sub>m_code[symmetric]]
 
   note 1 = has_all_wt_instances_ofD'[OF wf_trms_subterms[OF C_wf_trms] C_wf_trms 0(4)]
 
   have 2: "GSMP (?N2 (proj_unl l A)) \<subseteq> GSMP (?N2 (proj_unl l' A))" when "l \<notin> set ?L" for l l'
     using that L_in_iff GSMP_mono[of "?N2 (proj_unl l A)" "?N2 (proj_unl l' A)"]
           trms\<^sub>s\<^sub>s\<^sub>t_unlabel_subset_if_no_label[of l A]
           setops\<^sub>s\<^sub>s\<^sub>t_unlabel_subset_if_no_label[of l A]
     unfolding list_ex_iff by fast
 
   have 3: "GSMP_disjoint (?N2 (proj_unl l1 A)) (?N2 (proj_unl l2 A)) ?Sec"
     when "l1 \<in> set ?L" "l2 \<in> set ?L" "l1 \<noteq> l2" for l1 l2
   proof -
     have "GSMP_disjoint (set (?N1 (proj_unl l1 A))) (set (?N1 (proj_unl l2 A))) ?Sec"
       using 0(6) that
             GSMP_disjoint_if_comp_GSMP_disjoint[
               OF A_proj_wf_trms'[of l1] A_proj_wf_trms'[of l2] 0(3),
               of "M l1" "M l2"]
       unfolding f_def by blast
     thus ?thesis
       unfolding pair_code trms_list\<^sub>s\<^sub>s\<^sub>t_is_trms\<^sub>s\<^sub>s\<^sub>t setops_list\<^sub>s\<^sub>s\<^sub>t_is_setops\<^sub>s\<^sub>s\<^sub>t
       by simp
   qed
 
   obtain a1 a2 where a: "a1 \<in> set ?L" "a2 \<in> set ?L" "a1 \<noteq> a2"
     using remdups_ex2[OF 0(1)] by moura
 
   show "ground ?Sec" unfolding f_def by fastforce
 
   { fix i p j q
     assume p: "(i,p) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" and q: "(j,q) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A"
       and pq: "\<exists>\<delta>. Unifier \<delta> (pair p) (pair q)"
 
     have "\<exists>\<delta>. Unifier \<delta> (pair p) (pair q \<cdot> ?\<alpha> p)"
       using pq vars_term_disjoint_imp_unifier[OF var_rename_fv_disjoint[of "pair p"], of _ "pair q"]
       by (metis (no_types, lifting) subst_subst_compose var_rename_inv_comp)
     hence "i = j" using 0(7) mgu_None_is_subst_neq[of "pair p" "pair q \<cdot> ?\<alpha> p"] p q by fast
   } thus "\<forall>(i,p) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A. \<forall>(j,q) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A. (\<exists>\<delta>. Unifier \<delta> (pair p) (pair q)) \<longrightarrow> i = j"
     by blast
 
   show "\<forall>l1 l2. l1 \<noteq> l2 \<longrightarrow> GSMP_disjoint (?N2 (proj_unl l1 A)) (?N2 (proj_unl l2 A)) ?Sec"
     using 2 3 3[OF a] unfolding GSMP_disjoint_def by blast
 
   show "\<forall>s \<in> ?Sec. \<forall>s' \<in> subterms s. {} \<turnstile>\<^sub>c s' \<or> s' \<in> ?Sec"
   proof (intro ballI)
     fix s s'
     assume s: "s \<in> ?Sec" and s': "s' \<sqsubseteq> s"
     then obtain t \<delta> where t: "t \<in> set C" "s = t \<cdot> \<delta>" "fv s = {}" "\<not>{} \<turnstile>\<^sub>c s"
         and \<delta>: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)"
       unfolding f_def by blast
 
     obtain m \<theta> where m: "m \<in> set C" "s' = m \<cdot> \<theta>" and \<theta>: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>)"
       using TComp_var_and_subterm_instance_closed_has_subterms_instances[
               OF 0(5,4) C_wf_trms in_subterms_Union[OF t(1)] s'[unfolded t(2)] \<delta>]
       by blast
     thus "{} \<turnstile>\<^sub>c s' \<or> s' \<in> ?Sec"
       using ground_subterm[OF t(3) s']
       unfolding f_def by blast
   qed
 qed
 
 lemma par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_if_comp_par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t':
   defines "f \<equiv> \<lambda>M. {t \<cdot> \<delta> | t \<delta>. t \<in> M \<and> wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta> \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>) \<and> fv (t \<cdot> \<delta>) = {}}"
   assumes a: "comp_par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t public arity Ana \<Gamma> Pair A M C"
     and B: "\<forall>b \<in> set B. \<exists>a \<in> set A. \<exists>\<delta>. b = a \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta> \<and> wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta> \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)"
       (is "\<forall>b \<in> set B. \<exists>a \<in> set A. \<exists>\<delta>. b = a \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta> \<and> ?D \<delta>")
   shows "par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t B ((f (set C)) - {m. {} \<turnstile>\<^sub>c m})"
 proof (unfold par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def; intro conjI)
   define N1 where "N1 \<equiv> \<lambda>B::('fun, ('fun,'atom) term_type \<times> nat) stateful_strand.
     remdups (trms_list\<^sub>s\<^sub>s\<^sub>t B@map (pair' Pair) (setops_list\<^sub>s\<^sub>s\<^sub>t B))"
 
   define N2 where "N2 \<equiv> \<lambda>B::('fun, ('fun,'atom) term_type \<times> nat) stateful_strand.
     trms\<^sub>s\<^sub>s\<^sub>t B \<union> pair ` setops\<^sub>s\<^sub>s\<^sub>t B"
 
   define L where "L \<equiv> \<lambda>A::('fun, ('fun,'atom) term_type \<times> nat, 'lbl) labeled_stateful_strand.
     remdups (map (the_LabelN \<circ> fst) (filter (Not \<circ> is_LabelS) A))"
 
   define \<alpha> where "\<alpha> \<equiv> \<lambda>p. var_rename (max_var (pair p::('fun, ('fun,'atom) term_type \<times> nat) term))
     ::('fun, ('fun,'atom) term_type \<times> nat) subst"
 
   let ?Sec = "(f (set C)) - {m. {} \<turnstile>\<^sub>c m}"
 
   have 0:
       "length (L A) > 1"
       "list_all (wf\<^sub>t\<^sub>r\<^sub>m' arity) (N1 (unlabel A))"
       "list_all (wf\<^sub>t\<^sub>r\<^sub>m' arity) C"
       "has_all_wt_instances_of \<Gamma> (subterms\<^sub>s\<^sub>e\<^sub>t (set C)) (set C)"
       "is_TComp_var_instance_closed \<Gamma> C"
       "\<forall>i \<in> set (L A). \<forall>j \<in> set (L A). i \<noteq> j \<longrightarrow>
         comp_GSMP_disjoint public arity Ana \<Gamma> (N1 (proj_unl i A)) (N1 (proj_unl j A)) (M i) (M j) C"
       "\<forall>(i,p) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A. \<forall>(j,q) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A. i \<noteq> j \<longrightarrow> mgu (pair p) (pair q \<cdot> \<alpha> p) = None"
     using a unfolding comp_par_comp\<^sub>l\<^sub>s\<^sub>s\<^sub>t_def pair_code L_def N1_def \<alpha>_def by meson+
 
   note 1 = trms\<^sub>s\<^sub>s\<^sub>t_proj_subset(1) setops\<^sub>s\<^sub>s\<^sub>t_proj_subset(1)
 
   have N1_iff_N2: "set (N1 A) = N2 A" for A
     unfolding pair_code trms_list\<^sub>s\<^sub>s\<^sub>t_is_trms\<^sub>s\<^sub>s\<^sub>t setops_list\<^sub>s\<^sub>s\<^sub>t_is_setops\<^sub>s\<^sub>s\<^sub>t N1_def N2_def by simp
 
   have N2_proj_subset: "N2 (proj_unl l A) \<subseteq> N2 (unlabel A)"
     for l::'lbl and A::"('fun, ('fun,'atom) term_type \<times> nat, 'lbl) labeled_stateful_strand"
     using 1(1)[of l A] image_mono[OF 1(2)[of l A], of pair] unfolding N2_def by blast
 
   have L_in_iff: "l \<in> set (L A) \<longleftrightarrow> (\<exists>a \<in> set A. is_LabelN l a)" for l A
     unfolding L_def by force
 
   have L_B_subset_A: "l \<in> set (L A)" when l: "l \<in> set (L B)" for l
     using L_in_iff[of l B] L_in_iff[of l A] B l by fastforce
 
   note B_setops = setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t_wt_instance_ex[OF B]
 
   have B_proj: "\<forall>b \<in> set (proj l B). \<exists>a \<in> set (proj l A). \<exists>\<delta>. b = a \<cdot>\<^sub>l\<^sub>s\<^sub>s\<^sub>t\<^sub>p \<delta> \<and> ?D \<delta>" for l
     using proj_instance_ex[OF B] by fast
 
   have B': "\<forall>t \<in> N2 (unlabel B). \<exists>s \<in> N2 (unlabel A). \<exists>\<delta>. t = s \<cdot> \<delta> \<and> ?D \<delta>"
     using trms\<^sub>s\<^sub>s\<^sub>t_setops\<^sub>s\<^sub>s\<^sub>t_wt_instance_ex[OF B] unfolding N2_def by blast
 
   have B'_proj: "\<forall>t \<in> N2 (proj_unl l B). \<exists>s \<in> N2 (proj_unl l A). \<exists>\<delta>. t = s \<cdot> \<delta> \<and> ?D \<delta>" for l
     using trms\<^sub>s\<^sub>s\<^sub>t_setops\<^sub>s\<^sub>s\<^sub>t_wt_instance_ex[OF B_proj] unfolding N2_def by presburger
 
   have A_wf_trms: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (N2 (unlabel A))"
     using N1_iff_N2[of "unlabel A"] 0(2) unfolding wf\<^sub>t\<^sub>r\<^sub>m_code list_all_iff by auto
   hence A_proj_wf_trms: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (N2 (proj_unl l A))" for l
     using 1[of l] unfolding N2_def by blast
   hence A_proj_wf_trms': "list_all (wf\<^sub>t\<^sub>r\<^sub>m' arity) (N1 (proj_unl l A))" for l
     using N1_iff_N2[of "proj_unl l A"] unfolding wf\<^sub>t\<^sub>r\<^sub>m_code list_all_iff by presburger
 
   note C_wf_trms = 0(3)[unfolded list_all_iff wf\<^sub>t\<^sub>r\<^sub>m_code[symmetric]]
 
   have 2: "GSMP (N2 (proj_unl l A)) \<subseteq> GSMP (N2 (proj_unl l' A))"
     when "l \<notin> set (L A)" for l l'
       and A::"('fun, ('fun,'atom) term_type \<times> nat, 'lbl) labeled_stateful_strand"
     using that L_in_iff[of _ A] GSMP_mono[of "N2 (proj_unl l A)" "N2 (proj_unl l' A)"]
           trms\<^sub>s\<^sub>s\<^sub>t_unlabel_subset_if_no_label[of l A]
           setops\<^sub>s\<^sub>s\<^sub>t_unlabel_subset_if_no_label[of l A]
     unfolding list_ex_iff N2_def by fast
 
   have 3: "GSMP (N2 (proj_unl l B)) \<subseteq> GSMP (N2 (proj_unl l A))" (is "?X \<subseteq> ?Y") for l
   proof
     fix t assume "t \<in> ?X"
     hence t: "t \<in> SMP (N2 (proj_unl l B))" "fv t = {}" unfolding GSMP_def by simp_all
     have "t \<in> SMP (N2 (proj_unl l A))"
       using t(1) B'_proj[of l] SMP_wt_instances_subset[of "N2 (proj_unl l B)" "N2 (proj_unl l A)"]
       by metis
     thus "t \<in> ?Y" using t(2) unfolding GSMP_def by fast
   qed
 
   have "GSMP_disjoint (N2 (proj_unl l1 A)) (N2 (proj_unl l2 A)) ?Sec"
     when "l1 \<in> set (L A)" "l2 \<in> set (L A)" "l1 \<noteq> l2" for l1 l2
   proof -
     have "GSMP_disjoint (set (N1 (proj_unl l1 A))) (set (N1 (proj_unl l2 A))) ?Sec"
       using 0(6) that
             GSMP_disjoint_if_comp_GSMP_disjoint[
               OF A_proj_wf_trms'[of l1] A_proj_wf_trms'[of l2] 0(3),
               of "M l1" "M l2"]
       unfolding f_def by blast
     thus ?thesis using N1_iff_N2 by simp
   qed
   hence 4: "GSMP_disjoint (N2 (proj_unl l1 B)) (N2 (proj_unl l2 B)) ?Sec"
     when "l1 \<in> set (L A)" "l2 \<in> set (L A)" "l1 \<noteq> l2" for l1 l2
     using that 3 unfolding GSMP_disjoint_def by blast
 
   { fix i p j q
     assume p: "(i,p) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t B" and q: "(j,q) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t B"
       and pq: "\<exists>\<delta>. Unifier \<delta> (pair p) (pair q)"
 
     obtain p' \<delta>p where p': "(i,p') \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" "p = p' \<cdot>\<^sub>p \<delta>p" "pair p = pair p' \<cdot> \<delta>p"
       using p B_setops unfolding pair_def by auto
 
     obtain q' \<delta>q where q': "(j,q') \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t A" "q = q' \<cdot>\<^sub>p \<delta>q" "pair q = pair q' \<cdot> \<delta>q"
       using q B_setops unfolding pair_def by auto
 
     obtain \<theta> where "Unifier \<theta> (pair p) (pair q)" using pq by blast
     hence "\<exists>\<delta>. Unifier \<delta> (pair p') (pair q' \<cdot> \<alpha> p')"
       using p'(3) q'(3) var_rename_inv_comp[of "pair q'"] subst_subst_compose
             vars_term_disjoint_imp_unifier[
               OF var_rename_fv_disjoint[of "pair p'"],
               of "\<delta>p \<circ>\<^sub>s \<theta>" "pair q'" "var_rename_inv (max_var_set (fv (pair p'))) \<circ>\<^sub>s \<delta>q \<circ>\<^sub>s \<theta>"]
       unfolding \<alpha>_def by fastforce
     hence "i = j"
       using mgu_None_is_subst_neq[of "pair p'" "pair q' \<cdot> \<alpha> p'"] p'(1) q'(1) 0(7)
       unfolding \<alpha>_def by fast
   } thus "\<forall>(i,p) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t B. \<forall>(j,q) \<in> setops\<^sub>l\<^sub>s\<^sub>s\<^sub>t B. (\<exists>\<delta>. Unifier \<delta> (pair p) (pair q)) \<longrightarrow> i = j"
     by blast
 
   obtain a1 a2 where a: "a1 \<in> set (L A)" "a2 \<in> set (L A)" "a1 \<noteq> a2"
     using remdups_ex2[OF 0(1)[unfolded L_def]] unfolding L_def by moura
 
   show "\<forall>l1 l2. l1 \<noteq> l2 \<longrightarrow> GSMP_disjoint (N2 (proj_unl l1 B)) (N2 (proj_unl l2 B)) ?Sec"
     using 2[of _ B] 4 4[OF a] L_B_subset_A unfolding GSMP_disjoint_def by blast
 
   show "ground ?Sec" unfolding f_def by fastforce
 
   show "\<forall>s \<in> ?Sec. \<forall>s' \<in> subterms s. {} \<turnstile>\<^sub>c s' \<or> s' \<in> ?Sec"
   proof (intro ballI)
     fix s s'
     assume s: "s \<in> ?Sec" and s': "s' \<sqsubseteq> s"
     then obtain t \<delta> where t: "t \<in> set C" "s = t \<cdot> \<delta>" "fv s = {}" "\<not>{} \<turnstile>\<^sub>c s"
         and \<delta>: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)"
       unfolding f_def by blast
 
     obtain m \<theta> where m: "m \<in> set C" "s' = m \<cdot> \<theta>" and \<theta>: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>)"
       using TComp_var_and_subterm_instance_closed_has_subterms_instances[
               OF 0(5,4) C_wf_trms in_subterms_Union[OF t(1)] s'[unfolded t(2)] \<delta>]
       by blast
     thus "{} \<turnstile>\<^sub>c s' \<or> s' \<in> ?Sec"
       using ground_subterm[OF t(3) s']
       unfolding f_def by blast
   qed
 qed
 
 end
 
 end
diff --git a/thys/Stateful_Protocol_Composition_and_Typing/Typing_Result.thy b/thys/Stateful_Protocol_Composition_and_Typing/Typing_Result.thy
--- a/thys/Stateful_Protocol_Composition_and_Typing/Typing_Result.thy
+++ b/thys/Stateful_Protocol_Composition_and_Typing/Typing_Result.thy
@@ -1,3463 +1,3463 @@
 (*
 (C) Copyright Andreas Viktor Hess, DTU, 2015-2020
 
 All Rights Reserved.
 
 Redistribution and use in source and binary forms, with or without
 modification, are permitted provided that the following conditions are
 met:
 
 - Redistributions of source code must retain the above copyright
   notice, this list of conditions and the following disclaimer.
 
 - Redistributions in binary form must reproduce the above copyright
   notice, this list of conditions and the following disclaimer in the
   documentation and/or other materials provided with the distribution.
 
 - Neither the name of the copyright holder nor the names of its
   contributors may be used to endorse or promote products
   derived from this software without specific prior written
   permission.
 
 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
 A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
 OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
 SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
 LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
 DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
 THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
 (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
 OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 *)
 
 (*  Title:      Typing_Result.thy
     Author:     Andreas Viktor Hess, DTU
 *)
 
 section \<open>The Typing Result\<close>
 
 theory Typing_Result
 imports Typed_Model
 begin
 
 subsection \<open>The Typing Result for the Composition-Only Intruder\<close>
 context typed_model
 begin
 
 subsubsection \<open>Well-typedness and Type-Flaw Resistance Preservation\<close>
 context
 begin
 
 private lemma LI_preserves_tfr_stp_all_single:
   assumes "(S,\<theta>) \<leadsto> (S',\<theta>')" "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S \<theta>" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>"
   and "list_all tfr\<^sub>s\<^sub>t\<^sub>p S" "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t S)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t S)"
   shows "list_all tfr\<^sub>s\<^sub>t\<^sub>p S'"
 using assms
 proof (induction rule: LI_rel.induct)
   case (Compose S X f S' \<theta>)
   hence "list_all tfr\<^sub>s\<^sub>t\<^sub>p S" "list_all tfr\<^sub>s\<^sub>t\<^sub>p S'" by simp_all
   moreover have "list_all tfr\<^sub>s\<^sub>t\<^sub>p (map Send X)" by (induct X) auto
   ultimately show ?case by simp
 next
   case (Unify S f Y \<delta> X S' \<theta>)
   hence "list_all tfr\<^sub>s\<^sub>t\<^sub>p (S@S')" by simp
 
   have "fv\<^sub>s\<^sub>t (S@Send (Fun f X)#S') \<inter> bvars\<^sub>s\<^sub>t (S@S') = {}"
     using Unify.prems(1) by (auto simp add: wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r_def)
   moreover have "fv (Fun f X) \<subseteq> fv\<^sub>s\<^sub>t (S@Send (Fun f X)#S')" by auto
   moreover have "fv (Fun f Y) \<subseteq> fv\<^sub>s\<^sub>t (S@Send (Fun f X)#S')"
     using Unify.hyps(2) fv_subset_if_in_strand_ik'[of "Fun f Y" S] by force
   ultimately have bvars_disj:
       "bvars\<^sub>s\<^sub>t (S@S') \<inter> fv (Fun f X) = {}" "bvars\<^sub>s\<^sub>t (S@S') \<inter> fv (Fun f Y) = {}"
     by blast+
 
   have "wf\<^sub>t\<^sub>r\<^sub>m (Fun f X)" using Unify.prems(5) by simp
   moreover have "wf\<^sub>t\<^sub>r\<^sub>m (Fun f Y)"
   proof -
     obtain x where "x \<in> set S" "Fun f Y \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t\<^sub>p x)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t\<^sub>p x)"
       using Unify.hyps(2) Unify.prems(5) by force+
     thus ?thesis using wf_trm_subterm by auto
   qed
   moreover have
       "Fun f X \<in> SMP (trms\<^sub>s\<^sub>t (S@Send (Fun f X)#S'))" "Fun f Y \<in> SMP (trms\<^sub>s\<^sub>t (S@Send (Fun f X)#S'))"
     using SMP_append[of S "Send (Fun f X)#S'"] SMP_Cons[of "Send (Fun f X)" S']
           SMP_ikI[OF Unify.hyps(2)]
     by auto
   hence "\<Gamma> (Fun f X) = \<Gamma> (Fun f Y)"
     using Unify.prems(4) mgu_gives_MGU[OF Unify.hyps(3)[symmetric]]
     unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def by blast
   ultimately have "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>" using mgu_wt_if_same_type[OF Unify.hyps(3)[symmetric]] by metis
   moreover have "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)"
     using mgu_wf_trm[OF Unify.hyps(3)[symmetric] \<open>wf\<^sub>t\<^sub>r\<^sub>m (Fun f X)\<close> \<open>wf\<^sub>t\<^sub>r\<^sub>m (Fun f Y)\<close>]
     by (metis wf_trm_subst_range_iff)
   moreover have "bvars\<^sub>s\<^sub>t (S@S') \<inter> range_vars \<delta> = {}"
     using mgu_vars_bounded[OF Unify.hyps(3)[symmetric]] bvars_disj by fast
   ultimately show ?case using tfr_stp_all_wt_subst_apply[OF \<open>list_all tfr\<^sub>s\<^sub>t\<^sub>p (S@S')\<close>] by metis
 next
   case (Equality S \<delta> t t' a S' \<theta>)
   have "list_all tfr\<^sub>s\<^sub>t\<^sub>p (S@S')" "\<Gamma> t = \<Gamma> t'"
     using tfr_stp_all_same_type[of S a t t' S']
           tfr_stp_all_split(5)[of S _ S']
           MGU_is_Unifier[OF mgu_gives_MGU[OF Equality.hyps(2)[symmetric]]]
           Equality.prems(3)
     by blast+
   moreover have "wf\<^sub>t\<^sub>r\<^sub>m t" "wf\<^sub>t\<^sub>r\<^sub>m t'" using Equality.prems(5) by auto
   ultimately have "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>"
     using mgu_wt_if_same_type[OF Equality.hyps(2)[symmetric]]
     by metis
   moreover have "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)"
     using mgu_wf_trm[OF Equality.hyps(2)[symmetric] \<open>wf\<^sub>t\<^sub>r\<^sub>m t\<close> \<open>wf\<^sub>t\<^sub>r\<^sub>m t'\<close>]
     by (metis wf_trm_subst_range_iff)
   moreover have "fv\<^sub>s\<^sub>t (S@Equality a t t'#S') \<inter> bvars\<^sub>s\<^sub>t (S@Equality a t t'#S') = {}"
     using Equality.prems(1) by (auto simp add: wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r_def)
   hence "bvars\<^sub>s\<^sub>t (S@S') \<inter> fv t = {}" "bvars\<^sub>s\<^sub>t (S@S') \<inter> fv t' = {}" by auto
   hence "bvars\<^sub>s\<^sub>t (S@S') \<inter> range_vars \<delta> = {}"
     using mgu_vars_bounded[OF Equality.hyps(2)[symmetric]] by fast
   ultimately show ?case using tfr_stp_all_wt_subst_apply[OF \<open>list_all tfr\<^sub>s\<^sub>t\<^sub>p (S@S')\<close>] by metis
 qed
 
 private lemma LI_in_SMP_subset_single:
   assumes "(S,\<theta>) \<leadsto> (S',\<theta>')" "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S \<theta>" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>"
           "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t S)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t S)" "list_all tfr\<^sub>s\<^sub>t\<^sub>p S"
   and "trms\<^sub>s\<^sub>t S \<subseteq> SMP M"
   shows "trms\<^sub>s\<^sub>t S' \<subseteq> SMP M"
 using assms
 proof (induction rule: LI_rel.induct)
   case (Compose S X f S' \<theta>)
   hence "SMP (trms\<^sub>s\<^sub>t [Send (Fun f X)]) \<subseteq> SMP M"
   proof -
     have "SMP (trms\<^sub>s\<^sub>t [Send (Fun f X)]) \<subseteq> SMP (trms\<^sub>s\<^sub>t (S@Send (Fun f X)#S'))"
       using trms\<^sub>s\<^sub>t_append SMP_mono by auto
     thus ?thesis
       using SMP_union[of "trms\<^sub>s\<^sub>t (S@Send (Fun f X)#S')" M]
             SMP_subset_union_eq[OF Compose.prems(6)]
       by auto
   qed
   thus ?case using Compose.prems(6) by auto
 next
   case (Unify S f Y \<delta> X S' \<theta>)
   have "Fun f X \<in> SMP (trms\<^sub>s\<^sub>t (S@Send (Fun f X)#S'))" by auto
   moreover have "MGU \<delta> (Fun f X) (Fun f Y)"
     by (metis mgu_gives_MGU[OF Unify.hyps(3)[symmetric]])
   moreover have
         "\<And>x. x \<in> set S \<Longrightarrow> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t\<^sub>p x)" "wf\<^sub>t\<^sub>r\<^sub>m (Fun f X)"
     using Unify.prems(4) by force+
   moreover have "Fun f Y \<in> SMP (trms\<^sub>s\<^sub>t (S@Send (Fun f X)#S'))"
     by (meson SMP_ikI Unify.hyps(2) contra_subsetD ik_append_subset(1))
   ultimately have "wf\<^sub>t\<^sub>r\<^sub>m (Fun f Y)" "\<Gamma> (Fun f X) = \<Gamma> (Fun f Y)"
     using ik\<^sub>s\<^sub>t_subterm_exD[OF \<open>Fun f Y \<in> ik\<^sub>s\<^sub>t S\<close>] \<open>tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t (S@Send (Fun f X)#S'))\<close>
     unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def by (metis (full_types) SMP_wf_trm Unify.prems(4), blast)
   hence "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>" by (metis mgu_wt_if_same_type[OF Unify.hyps(3)[symmetric] \<open>wf\<^sub>t\<^sub>r\<^sub>m (Fun f X)\<close>])
   moreover have "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)"
     using mgu_wf_trm[OF Unify.hyps(3)[symmetric] \<open>wf\<^sub>t\<^sub>r\<^sub>m (Fun f X)\<close> \<open>wf\<^sub>t\<^sub>r\<^sub>m (Fun f Y)\<close>] by simp
   ultimately have "trms\<^sub>s\<^sub>t ((S@Send (Fun f X)#S') \<cdot>\<^sub>s\<^sub>t \<delta>) \<subseteq> SMP M"
     using SMP.Substitution Unify.prems(6) wt_subst_SMP_subset by metis
   thus ?case by auto
 next
   case (Equality S \<delta> t t' a S' \<theta>)
   hence "\<Gamma> t = \<Gamma> t'"
     using tfr_stp_all_same_type MGU_is_Unifier[OF mgu_gives_MGU[OF Equality.hyps(2)[symmetric]]]
     by metis
   moreover have "t \<in> SMP (trms\<^sub>s\<^sub>t (S@Equality a t t'#S'))" "t' \<in> SMP (trms\<^sub>s\<^sub>t (S@Equality a t t'#S'))"
     using Equality.prems(1) by auto
   moreover have "MGU \<delta> t t'" using mgu_gives_MGU[OF Equality.hyps(2)[symmetric]] by metis
   moreover have "\<And>x. x \<in> set S \<Longrightarrow> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t\<^sub>p x)" "wf\<^sub>t\<^sub>r\<^sub>m t" "wf\<^sub>t\<^sub>r\<^sub>m t'"
     using Equality.prems(4) by force+
   ultimately have "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>" by (metis mgu_wt_if_same_type[OF Equality.hyps(2)[symmetric] \<open>wf\<^sub>t\<^sub>r\<^sub>m t\<close>])
   moreover have "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)"
     using mgu_wf_trm[OF Equality.hyps(2)[symmetric] \<open>wf\<^sub>t\<^sub>r\<^sub>m t\<close> \<open>wf\<^sub>t\<^sub>r\<^sub>m t'\<close>] by simp
   ultimately have "trms\<^sub>s\<^sub>t ((S@Equality a t t'#S') \<cdot>\<^sub>s\<^sub>t \<delta>) \<subseteq> SMP M"
     using SMP.Substitution Equality.prems wt_subst_SMP_subset by metis
   thus ?case by auto
 qed
 
 private lemma LI_preserves_tfr_single:
   assumes "(S,\<theta>) \<leadsto> (S',\<theta>')" "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S \<theta>" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>)"
           "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t S)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t S)"
           "list_all tfr\<^sub>s\<^sub>t\<^sub>p S"
   shows "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t S') \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t S')"
 using assms
 proof (induction rule: LI_rel.induct)
   case (Compose S X f S' \<theta>)
   let ?SMPmap = "SMP (trms\<^sub>s\<^sub>t (S@map Send X@S')) - (Var`\<V>)"
   have "?SMPmap \<subseteq> SMP (trms\<^sub>s\<^sub>t (S@Send (Fun f X)#S')) - (Var`\<V>)"
     using SMP_fun_map_snd_subset[of X f]
           SMP_append[of "map Send X" S'] SMP_Cons[of "Send (Fun f X)" S']
           SMP_append[of S "Send (Fun f X)#S'"] SMP_append[of S "map Send X@S'"]
     by auto
   hence "\<forall>s \<in> ?SMPmap. \<forall>t \<in> ?SMPmap. (\<exists>\<delta>. Unifier \<delta> s t) \<longrightarrow> \<Gamma> s = \<Gamma> t"
     using Compose unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def by (meson subsetCE)
   thus ?case
     using LI_preserves_trm_wf[OF r_into_rtrancl[OF LI_rel.Compose[OF Compose.hyps]], of S']
           Compose.prems(5)
     unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def by blast
 next
   case (Unify S f Y \<delta> X S' \<theta>)
   let ?SMP\<delta> = "SMP (trms\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>)) - (Var`\<V>)"
 
   have "SMP (trms\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>)) \<subseteq> SMP (trms\<^sub>s\<^sub>t (S@Send (Fun f X)#S'))"
   proof
     fix s assume "s \<in> SMP (trms\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>))" thus "s \<in> SMP (trms\<^sub>s\<^sub>t (S@Send (Fun f X)#S'))"
       using LI_in_SMP_subset_single[
               OF LI_rel.Unify[OF Unify.hyps] Unify.prems(1,2,4,5,6)
                  MP_subset_SMP(2)[of "S@Send (Fun f X)#S'"]]
       by (metis SMP_union SMP_subset_union_eq Un_iff)
   qed
   hence "\<forall>s \<in> ?SMP\<delta>. \<forall>t \<in> ?SMP\<delta>. (\<exists>\<delta>. Unifier \<delta> s t) \<longrightarrow> \<Gamma> s = \<Gamma> t"
     using Unify.prems(4) unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def by (meson Diff_iff subsetCE)
   thus ?case
     using LI_preserves_trm_wf[OF r_into_rtrancl[OF LI_rel.Unify[OF Unify.hyps]], of S']
           Unify.prems(5)
     unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def by blast
 next
   case (Equality S \<delta> t t' a S' \<theta>)
   let ?SMP\<delta> = "SMP (trms\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>)) - (Var`\<V>)"
 
   have "SMP (trms\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>)) \<subseteq> SMP (trms\<^sub>s\<^sub>t (S@Equality a t t'#S'))"
   proof
     fix s assume "s \<in> SMP (trms\<^sub>s\<^sub>t (S@S' \<cdot>\<^sub>s\<^sub>t \<delta>))" thus "s \<in> SMP (trms\<^sub>s\<^sub>t (S@Equality a t t'#S'))"
       using LI_in_SMP_subset_single[
               OF LI_rel.Equality[OF Equality.hyps] Equality.prems(1,2,4,5,6)
                  MP_subset_SMP(2)[of "S@Equality a t t'#S'"]]
       by (metis SMP_union SMP_subset_union_eq Un_iff)
   qed
   hence "\<forall>s \<in> ?SMP\<delta>. \<forall>t \<in> ?SMP\<delta>. (\<exists>\<delta>. Unifier \<delta> s t) \<longrightarrow> \<Gamma> s = \<Gamma> t"
     using Equality.prems unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def by (meson Diff_iff subsetCE)
   thus ?case
     using LI_preserves_trm_wf[OF r_into_rtrancl[OF LI_rel.Equality[OF Equality.hyps]], of _ S']
           Equality.prems
     unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def by blast
 qed
 
 private lemma LI_preserves_welltypedness_single:
   assumes "(S,\<theta>) \<leadsto> (S',\<theta>')" "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S \<theta>" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>)"
   and "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t S)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t S)" "list_all tfr\<^sub>s\<^sub>t\<^sub>p S"
   shows "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>' \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>')"
 using assms
 proof (induction rule: LI_rel.induct)
   case (Unify S f Y \<delta> X S' \<theta>)
   have "wf\<^sub>t\<^sub>r\<^sub>m (Fun f X)" using Unify.prems(5) unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def by simp
   moreover have "wf\<^sub>t\<^sub>r\<^sub>m (Fun f Y)"
   proof -
     obtain x where "x \<in> set S" "Fun f Y \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t\<^sub>p x)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t\<^sub>p x)"
       using Unify.hyps(2) Unify.prems(5) unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def by force
     thus ?thesis using wf_trm_subterm by auto
   qed
   moreover have
       "Fun f X \<in> SMP (trms\<^sub>s\<^sub>t (S@Send (Fun f X)#S'))" "Fun f Y \<in> SMP (trms\<^sub>s\<^sub>t (S@Send (Fun f X)#S'))"
     using SMP_append[of S "Send (Fun f X)#S'"] SMP_Cons[of "Send (Fun f X)" S']
           SMP_ikI[OF Unify.hyps(2)]
     by auto
   hence "\<Gamma> (Fun f X) = \<Gamma> (Fun f Y)"
     using Unify.prems(4) mgu_gives_MGU[OF Unify.hyps(3)[symmetric]]
     unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def by blast
   ultimately have "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>" using mgu_wt_if_same_type[OF Unify.hyps(3)[symmetric]] by metis
 
   have "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)"
     by (meson mgu_wf_trm[OF Unify.hyps(3)[symmetric] \<open>wf\<^sub>t\<^sub>r\<^sub>m (Fun f X)\<close> \<open>wf\<^sub>t\<^sub>r\<^sub>m (Fun f Y)\<close>]
               wf_trm_subst_range_iff)
   hence "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range (\<theta> \<circ>\<^sub>s \<delta>))"
     using wf_trm_subst_range_iff wf_trm_subst \<open>wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>)\<close>
     unfolding subst_compose_def
     by (metis (no_types, lifting))
   thus ?case by (metis wt_subst_compose[OF \<open>wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>\<close> \<open>wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>\<close>])
 next
   case (Equality S \<delta> t t' a S' \<theta>)
   have "wf\<^sub>t\<^sub>r\<^sub>m t" "wf\<^sub>t\<^sub>r\<^sub>m t'" using Equality.prems(5) by simp_all
   moreover have "\<Gamma> t = \<Gamma> t'"
     using \<open>list_all tfr\<^sub>s\<^sub>t\<^sub>p (S@Equality a t t'#S')\<close>
           MGU_is_Unifier[OF mgu_gives_MGU[OF Equality.hyps(2)[symmetric]]]
     by auto
   ultimately have "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>" using mgu_wt_if_same_type[OF Equality.hyps(2)[symmetric]] by metis
 
   have "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)"
     by (meson mgu_wf_trm[OF Equality.hyps(2)[symmetric] \<open>wf\<^sub>t\<^sub>r\<^sub>m t\<close> \<open>wf\<^sub>t\<^sub>r\<^sub>m t'\<close>] wf_trm_subst_range_iff)
   hence "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range (\<theta> \<circ>\<^sub>s \<delta>))"
     using wf_trm_subst_range_iff wf_trm_subst \<open>wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>)\<close>
     unfolding subst_compose_def
     by (metis (no_types, lifting))
   thus ?case by (metis wt_subst_compose[OF \<open>wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>\<close> \<open>wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>\<close>])
 qed metis
 
 lemma LI_preserves_welltypedness:
   assumes "(S,\<theta>) \<leadsto>\<^sup>* (S',\<theta>')" "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S \<theta>" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>)"
     and "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t S)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t S)" "list_all tfr\<^sub>s\<^sub>t\<^sub>p S"
   shows "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>'" (is "?A \<theta>'")
     and "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>')" (is "?B \<theta>'")
 proof -
   have "?A \<theta>' \<and> ?B \<theta>'" using assms
   proof (induction S \<theta> rule: converse_rtrancl_induct2)
     case (step S1 \<theta>1 S2 \<theta>2)
     hence "?A \<theta>2 \<and> ?B \<theta>2" using LI_preserves_welltypedness_single by presburger
     moreover have "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S2 \<theta>2"
       by (fact LI_preserves_wellformedness[OF r_into_rtrancl[OF step.hyps(1)] step.prems(1)])
     moreover have "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t S2)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t S2)"
       using LI_preserves_tfr_single[OF step.hyps(1)] step.prems by presburger+
     moreover have "list_all tfr\<^sub>s\<^sub>t\<^sub>p S2"
       using LI_preserves_tfr_stp_all_single[OF step.hyps(1)] step.prems by fastforce
     ultimately show ?case using step.IH by presburger
   qed simp
   thus "?A \<theta>'" "?B \<theta>'" by simp_all
 qed
 
 lemma LI_preserves_tfr:
   assumes "(S,\<theta>) \<leadsto>\<^sup>* (S',\<theta>')" "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S \<theta>" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>)"
     and "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t S)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t S)" "list_all tfr\<^sub>s\<^sub>t\<^sub>p S"
   shows "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t S')" (is "?A S'")
     and "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t S')" (is "?B S'")
     and "list_all tfr\<^sub>s\<^sub>t\<^sub>p S'" (is "?C S'")
 proof -
   have "?A S' \<and> ?B S' \<and> ?C S'" using assms
   proof (induction S \<theta> rule: converse_rtrancl_induct2)
     case (step S1 \<theta>1 S2 \<theta>2)
     have "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S2 \<theta>2" "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t S2)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t S2)" "list_all tfr\<^sub>s\<^sub>t\<^sub>p S2"
       using LI_preserves_wellformedness[OF r_into_rtrancl[OF step.hyps(1)] step.prems(1)]
             LI_preserves_tfr_single[OF step.hyps(1) step.prems(1,2)]
             LI_preserves_tfr_stp_all_single[OF step.hyps(1) step.prems(1,2)]
             step.prems(3,4,5,6)
       by metis+
     moreover have "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>2" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>2)"
       using LI_preserves_welltypedness[OF r_into_rtrancl[OF step.hyps(1)] step.prems]
       by simp_all
     ultimately show ?case using step.IH by presburger
   qed blast
   thus "?A S'" "?B S'" "?C S'" by simp_all
 qed
 end
 
 subsubsection \<open>Simple Constraints are Well-typed Satisfiable\<close>
 text \<open>Proving the existence of a well-typed interpretation\<close>
 context
 begin
-lemma wt_interpretation_exists: 
+lemma wt_interpretation_exists:
   obtains \<I>::"('fun,'var) subst"
   where "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>" "subst_range \<I> \<subseteq> public_ground_wf_terms"
 proof
   define \<I> where "\<I> = (\<lambda>x. (SOME t. \<Gamma> (Var x) = \<Gamma> t \<and> public_ground_wf_term t))"
 
   { fix x t assume "\<I> x = t"
     hence "\<Gamma> (Var x) = \<Gamma> t \<and> public_ground_wf_term t"
       using someI_ex[of "\<lambda>t. \<Gamma> (Var x) = \<Gamma> t \<and> public_ground_wf_term t",
                      OF type_pgwt_inhabited[of "Var x"]]
       unfolding \<I>_def wf\<^sub>t\<^sub>r\<^sub>m_def by simp
   } hence props: "\<I> v = t \<Longrightarrow> \<Gamma> (Var v) = \<Gamma> t \<and> public_ground_wf_term t" for v t by metis
 
-  have "\<I> v \<noteq> Var v" for v using props pgwt_ground by force
+  have "\<I> v \<noteq> Var v" for v using props pgwt_ground by (simp add: empty_fv_not_var)
   hence "subst_domain \<I> = UNIV" by auto
   moreover have "ground (subst_range \<I>)" by (simp add: props pgwt_ground)
   ultimately show "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>" by metis
   show "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>" unfolding wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def using props by simp
   show "subst_range \<I> \<subseteq> public_ground_wf_terms" by (auto simp add: props)
 qed
 
 lemma wt_grounding_subst_exists:
   "\<exists>\<theta>. wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta> \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>) \<and> fv (t \<cdot> \<theta>) = {}"
 proof -
   obtain \<theta> where \<theta>: "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>" "subst_range \<theta> \<subseteq> public_ground_wf_terms"
     using wt_interpretation_exists by blast
   show ?thesis using pgwt_wellformed interpretation_grounds[OF \<theta>(1)] \<theta>(2,3) by blast
 qed
 
 private fun fresh_pgwt::"'fun set \<Rightarrow> ('fun,'atom) term_type \<Rightarrow> ('fun,'var) term"  where
   "fresh_pgwt S (TAtom a) =
     Fun (SOME c. c \<notin> S \<and> \<Gamma> (Fun c []) = TAtom a \<and> public c) []"
 | "fresh_pgwt S (TComp f T) = Fun f (map (fresh_pgwt S) T)"
 
 private lemma fresh_pgwt_same_type:
   assumes "finite S" "wf\<^sub>t\<^sub>r\<^sub>m t"
   shows "\<Gamma> (fresh_pgwt S (\<Gamma> t)) = \<Gamma> t"
 proof -
   let ?P = "\<lambda>\<tau>::('fun,'atom) term_type. wf\<^sub>t\<^sub>r\<^sub>m \<tau> \<and> (\<forall>f T. TComp f T \<sqsubseteq> \<tau> \<longrightarrow> 0 < arity f)"
   { fix \<tau> assume "?P \<tau>" hence "\<Gamma> (fresh_pgwt S \<tau>) = \<tau>"
     proof (induction \<tau>)
       case (Var a)
       let ?P = "\<lambda>c. c \<notin> S \<and> \<Gamma> (Fun c []) = Var a \<and> public c"
       let ?Q = "\<lambda>c. \<Gamma> (Fun c []) = Var a \<and> public c"
       have " {c. ?Q c} - S = {c. ?P c}" by auto
       hence "infinite {c. ?P c}"
-        using Diff_infinite_finite[OF assms(1) infinite_typed_consts[of a]] 
+        using Diff_infinite_finite[OF assms(1) infinite_typed_consts[of a]]
         by metis
       hence "\<exists>c. ?P c" using not_finite_existsD by blast
       thus ?case using someI_ex[of ?P] by auto
     next
       case (Fun f T)
       have f: "0 < arity f" using Fun.prems fun_type_inv by auto
       have "\<And>t. t \<in> set T \<Longrightarrow> ?P t"
         using Fun.prems wf_trm_subtermeq term.le_less_trans Fun_param_is_subterm
         by metis
       hence "\<And>t. t \<in> set T \<Longrightarrow> \<Gamma> (fresh_pgwt S t) = t" using Fun.prems Fun.IH by auto
       hence "map \<Gamma> (map (fresh_pgwt S) T) = T"  by (induct T) auto
       thus ?case using fun_type[OF f] by simp
     qed
   } thus ?thesis using assms(1) \<Gamma>_wf'[OF assms(2)] \<Gamma>_wf(1) by auto
 qed
 
 private lemma fresh_pgwt_empty_synth:
   assumes "finite S" "wf\<^sub>t\<^sub>r\<^sub>m t"
   shows "{} \<turnstile>\<^sub>c fresh_pgwt S (\<Gamma> t)"
 proof -
   let ?P = "\<lambda>\<tau>::('fun,'atom) term_type. wf\<^sub>t\<^sub>r\<^sub>m \<tau> \<and> (\<forall>f T. TComp f T \<sqsubseteq> \<tau> \<longrightarrow> 0 < arity f)"
   { fix \<tau> assume "?P \<tau>" hence "{} \<turnstile>\<^sub>c fresh_pgwt S \<tau>"
     proof (induction \<tau>)
       case (Var a)
       let ?P = "\<lambda>c. c \<notin> S \<and> \<Gamma> (Fun c []) = Var a \<and> public c"
       let ?Q = "\<lambda>c. \<Gamma> (Fun c []) = Var a \<and> public c"
       have " {c. ?Q c} - S = {c. ?P c}" by auto
       hence "infinite {c. ?P c}"
-        using Diff_infinite_finite[OF assms(1) infinite_typed_consts[of a]] 
+        using Diff_infinite_finite[OF assms(1) infinite_typed_consts[of a]]
         by metis
       hence "\<exists>c. ?P c" using not_finite_existsD by blast
       thus ?case
         using someI_ex[of ?P] intruder_synth.ComposeC[of "[]" _ "{}"] const_type_inv
         by auto
     next
       case (Fun f T)
-      have f: "0 < arity f" "length T = arity f" "public f" 
+      have f: "0 < arity f" "length T = arity f" "public f"
         using Fun.prems fun_type_inv unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by auto
       have "\<And>t. t \<in> set T \<Longrightarrow> ?P t"
         using Fun.prems wf_trm_subtermeq term.le_less_trans Fun_param_is_subterm
         by metis
       hence "\<And>t. t \<in> set T \<Longrightarrow> {} \<turnstile>\<^sub>c fresh_pgwt S t" using Fun.prems Fun.IH by auto
       moreover have "length (map (fresh_pgwt S) T) = arity f" using f(2) by auto
       ultimately show ?case using intruder_synth.ComposeC[of "map (fresh_pgwt S) T" f] f by auto
     qed
   } thus ?thesis using assms(1) \<Gamma>_wf'[OF assms(2)] \<Gamma>_wf(1) by auto
 qed
 
 private lemma fresh_pgwt_has_fresh_const:
   assumes "finite S" "wf\<^sub>t\<^sub>r\<^sub>m t"
   obtains c where "Fun c [] \<sqsubseteq> fresh_pgwt S (\<Gamma> t)" "c \<notin> S"
 proof -
   let ?P = "\<lambda>\<tau>::('fun,'atom) term_type. wf\<^sub>t\<^sub>r\<^sub>m \<tau> \<and> (\<forall>f T. TComp f T \<sqsubseteq> \<tau> \<longrightarrow> 0 < arity f)"
   { fix \<tau> assume "?P \<tau>" hence "\<exists>c. Fun c [] \<sqsubseteq> fresh_pgwt S \<tau> \<and> c \<notin> S"
     proof (induction \<tau>)
       case (Var a)
       let ?P = "\<lambda>c. c \<notin> S \<and> \<Gamma> (Fun c []) = Var a \<and> public c"
       let ?Q = "\<lambda>c. \<Gamma> (Fun c []) = Var a \<and> public c"
       have " {c. ?Q c} - S = {c. ?P c}" by auto
       hence "infinite {c. ?P c}"
-        using Diff_infinite_finite[OF assms(1) infinite_typed_consts[of a]] 
+        using Diff_infinite_finite[OF assms(1) infinite_typed_consts[of a]]
         by metis
       hence "\<exists>c. ?P c" using not_finite_existsD by blast
       thus ?case using someI_ex[of ?P] by auto
     next
       case (Fun f T)
       have f: "0 < arity f" "length T = arity f" "public f" "T \<noteq> []"
         using Fun.prems fun_type_inv unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by auto
-      obtain t' where t': "t' \<in> set T" by (meson all_not_in_conv f(4) set_empty) 
+      obtain t' where t': "t' \<in> set T" by (meson all_not_in_conv f(4) set_empty)
       have "\<And>t. t \<in> set T \<Longrightarrow> ?P t"
         using Fun.prems wf_trm_subtermeq term.le_less_trans Fun_param_is_subterm
         by metis
       hence "\<And>t. t \<in> set T \<Longrightarrow> \<exists>c. Fun c [] \<sqsubseteq> fresh_pgwt S t \<and> c \<notin> S"
         using Fun.prems Fun.IH by auto
       then obtain c where c: "Fun c [] \<sqsubseteq> fresh_pgwt S t'" "c \<notin> S" using t' by metis
       thus ?case using t' by auto
     qed
-  } thus ?thesis using that assms \<Gamma>_wf'[OF assms(2)] \<Gamma>_wf(1) by blast 
+  } thus ?thesis using that assms \<Gamma>_wf'[OF assms(2)] \<Gamma>_wf(1) by blast
 qed
 
 private lemma fresh_pgwt_subterm_fresh:
   assumes "finite S" "wf\<^sub>t\<^sub>r\<^sub>m t" "wf\<^sub>t\<^sub>r\<^sub>m s" "funs_term s \<subseteq> S"
   shows "s \<notin> subterms (fresh_pgwt S (\<Gamma> t))"
 proof -
   let ?P = "\<lambda>\<tau>::('fun,'atom) term_type. wf\<^sub>t\<^sub>r\<^sub>m \<tau> \<and> (\<forall>f T. TComp f T \<sqsubseteq> \<tau> \<longrightarrow> 0 < arity f)"
   { fix \<tau> assume "?P \<tau>" hence "s \<notin> subterms (fresh_pgwt S \<tau>)"
     proof (induction \<tau>)
       case (Var a)
       let ?P = "\<lambda>c. c \<notin> S \<and> \<Gamma> (Fun c []) = Var a \<and> public c"
       let ?Q = "\<lambda>c. \<Gamma> (Fun c []) = Var a \<and> public c"
       have " {c. ?Q c} - S = {c. ?P c}" by auto
       hence "infinite {c. ?P c}"
-        using Diff_infinite_finite[OF assms(1) infinite_typed_consts[of a]] 
+        using Diff_infinite_finite[OF assms(1) infinite_typed_consts[of a]]
         by metis
       hence "\<exists>c. ?P c" using not_finite_existsD by blast
       thus ?case using someI_ex[of ?P] assms(4) by auto
     next
       case (Fun f T)
-      have f: "0 < arity f" "length T = arity f" "public f" 
+      have f: "0 < arity f" "length T = arity f" "public f"
         using Fun.prems fun_type_inv unfolding wf\<^sub>t\<^sub>r\<^sub>m_def by auto
       have "\<And>t. t \<in> set T \<Longrightarrow> ?P t"
         using Fun.prems wf_trm_subtermeq term.le_less_trans Fun_param_is_subterm
         by metis
       hence "\<And>t. t \<in> set T \<Longrightarrow> s \<notin> subterms (fresh_pgwt S t)" using Fun.prems Fun.IH by auto
       moreover have "s \<noteq> fresh_pgwt S (Fun f T)"
       proof -
         obtain c where c: "Fun c [] \<sqsubseteq> fresh_pgwt S (Fun f T)" "c \<notin> S"
           using fresh_pgwt_has_fresh_const[OF assms(1)] type_wfttype_inhabited Fun.prems
           by metis
         hence "\<not>Fun c [] \<sqsubseteq> s" using assms(4) subtermeq_imp_funs_term_subset by force
         thus ?thesis using c(1) by auto
       qed
       ultimately show ?case by auto
     qed
   } thus ?thesis using assms(1) \<Gamma>_wf'[OF assms(2)] \<Gamma>_wf(1) by auto
 qed
 
 private lemma wt_fresh_pgwt_term_exists:
   assumes "finite T" "wf\<^sub>t\<^sub>r\<^sub>m s" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s T"
   obtains t where "\<Gamma> t = \<Gamma> s" "{} \<turnstile>\<^sub>c t" "\<forall>s \<in> T. \<forall>u \<in> subterms s. u \<notin> subterms t"
 proof -
   have finite_S: "finite (\<Union>(funs_term ` T))" using assms(1) by auto
 
   have 1: "\<Gamma> (fresh_pgwt (\<Union>(funs_term ` T)) (\<Gamma> s)) = \<Gamma> s"
     using fresh_pgwt_same_type[OF finite_S assms(2)] by auto
 
   have 2: "{} \<turnstile>\<^sub>c fresh_pgwt (\<Union>(funs_term ` T)) (\<Gamma> s)"
     using fresh_pgwt_empty_synth[OF finite_S assms(2)] by auto
 
   have 3: "\<forall>v \<in> T. \<forall>u \<in> subterms v. u \<notin> subterms (fresh_pgwt (\<Union>(funs_term ` T)) (\<Gamma> s))"
     using fresh_pgwt_subterm_fresh[OF finite_S assms(2)] assms(3)
           wf_trm_subtermeq subtermeq_imp_funs_term_subset
     by force
 
   show ?thesis by (rule that[OF 1 2 3])
 qed
 
 lemma wt_bij_finite_subst_exists:
   assumes "finite (S::'var set)" "finite (T::('fun,'var) terms)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s T"
   shows "\<exists>\<sigma>::('fun,'var) subst.
               subst_domain \<sigma> = S
             \<and> bij_betw \<sigma> (subst_domain \<sigma>) (subst_range \<sigma>)
             \<and> subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \<sigma>) \<subseteq> {t. {} \<turnstile>\<^sub>c t} - T
             \<and> (\<forall>s \<in> subst_range \<sigma>. \<forall>u \<in> subst_range \<sigma>. (\<exists>v. v \<sqsubseteq> s \<and> v \<sqsubseteq> u) \<longrightarrow> s = u)
             \<and> wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<sigma>
             \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<sigma>)"
 using assms
 proof (induction rule: finite_induct)
   case empty
   have "subst_domain Var = {}"
        "bij_betw Var (subst_domain Var) (subst_range Var)"
        "subterms\<^sub>s\<^sub>e\<^sub>t (subst_range Var) \<subseteq> {t. {} \<turnstile>\<^sub>c t} - T"
        "\<forall>s \<in> subst_range Var. \<forall>u \<in> subst_range Var. (\<exists>v. v \<sqsubseteq> s \<and> v \<sqsubseteq> u) \<longrightarrow> s = u"
        "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t Var"
        "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range Var)"
     unfolding bij_betw_def
     by auto
   thus ?case by (force simp add: subst_domain_def)
 next
   case (insert x S)
   then obtain \<sigma> where \<sigma>:
       "subst_domain \<sigma> = S" "bij_betw \<sigma> (subst_domain \<sigma>) (subst_range \<sigma>)"
       "subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \<sigma>) \<subseteq> {t. {} \<turnstile>\<^sub>c t} - T"
       "\<forall>s \<in> subst_range \<sigma>. \<forall>u \<in> subst_range \<sigma>. (\<exists>v. v \<sqsubseteq> s \<and> v \<sqsubseteq> u) \<longrightarrow> s = u"
       "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<sigma>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<sigma>)"
     by (auto simp del: subst_range.simps)
 
   have *: "finite (T \<union> subst_range \<sigma>)"
     using insert.prems(1) insert.hyps(1) \<sigma>(1) by simp
   have **: "wf\<^sub>t\<^sub>r\<^sub>m (Var x)" by simp
   have ***: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (T \<union> subst_range \<sigma>)" using assms(3) \<sigma>(6) by blast
   obtain t where t:
       "\<Gamma> t = \<Gamma> (Var x)" "{} \<turnstile>\<^sub>c t"
       "\<forall>s \<in> T \<union> subst_range \<sigma>. \<forall>u \<in> subterms s. u \<notin> subterms t"
     using wt_fresh_pgwt_term_exists[OF * ** ***] by auto
 
   obtain \<theta> where \<theta>: "\<theta> \<equiv> \<lambda>y. if x = y then t else \<sigma> y" by simp
 
   have t_ground: "fv t = {}" using t(2) pgwt_ground[of t] pgwt_is_empty_synth[of t] by auto
   hence x_dom: "x \<notin> subst_domain \<sigma>" "x \<in> subst_domain \<theta>" using insert.hyps(2) \<sigma>(1) \<theta> by auto
   moreover have "subst_range \<sigma> \<subseteq> subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \<sigma>)" by auto
   hence ground_imgs: "ground (subst_range \<sigma>)"
     using \<sigma>(3) pgwt_ground pgwt_is_empty_synth
     by force
   ultimately have x_img: "\<sigma> x \<notin> subst_range \<sigma>"
     using ground_subst_dom_iff_img
     by (auto simp add: subst_domain_def)
 
   have "ground (insert t (subst_range \<sigma>))"
     using ground_imgs x_dom t_ground
     by auto
   have \<theta>_dom: "subst_domain \<theta> = insert x (subst_domain \<sigma>)"
     using \<theta> t_ground by (auto simp add: subst_domain_def)
   have \<theta>_img: "subst_range \<theta> = insert t (subst_range \<sigma>)"
   proof
     show "subst_range \<theta> \<subseteq> insert t (subst_range \<sigma>)"
     proof
       fix t' assume "t' \<in> subst_range \<theta>"
       then obtain y where "y \<in> subst_domain \<theta>" "t' = \<theta> y" by auto
       thus "t' \<in> insert t (subst_range \<sigma>)" using \<theta> by (auto simp add: subst_domain_def)
     qed
     show "insert t (subst_range \<sigma>) \<subseteq> subst_range \<theta>"
     proof
       fix t' assume t': "t' \<in> insert t (subst_range \<sigma>)"
       hence "fv t' = {}" using ground_imgs x_img t_ground by auto
       hence "t' \<noteq> Var x" by auto
       show "t' \<in> subst_range \<theta>"
       proof (cases "t' = t")
         case False
         hence "t' \<in> subst_range \<sigma>" using t' by auto
         then obtain y where "\<sigma> y \<in> subst_range \<sigma>" "t' = \<sigma> y" by auto
         hence "y \<in> subst_domain \<sigma>" "t' \<noteq> Var y"
           using ground_subst_dom_iff_img[OF ground_imgs(1)]
           by (auto simp add: subst_domain_def simp del: subst_range.simps)
         hence "x \<noteq> y" using x_dom by auto
         hence "\<theta> y = \<sigma> y" unfolding \<theta> by auto
         thus ?thesis using \<open>t' \<noteq> Var y\<close> \<open>t' = \<sigma> y\<close> subst_imgI[of \<theta> y] by auto
       qed (metis subst_imgI \<theta> \<open>t' \<noteq> Var x\<close>)
     qed
   qed
   hence \<theta>_ground_img: "ground (subst_range \<theta>)"
     using ground_imgs t_ground
     by auto
 
   have "subst_domain \<theta> = insert x S" using \<theta>_dom \<sigma>(1) by auto
   moreover have "bij_betw \<theta> (subst_domain \<theta>) (subst_range \<theta>)"
   proof (intro bij_betwI')
     fix y z assume *: "y \<in> subst_domain \<theta>" "z \<in> subst_domain \<theta>"
     hence "fv (\<theta> y) = {}" "fv (\<theta> z) = {}" using \<theta>_ground_img by auto
     { assume "\<theta> y = \<theta> z" hence "y = z"
       proof (cases "\<theta> y \<in> subst_range \<sigma> \<and> \<theta> z \<in> subst_range \<sigma>")
         case True
         hence **: "y \<in> subst_domain \<sigma>" "z \<in> subst_domain \<sigma>"
-          using \<theta> \<theta>_dom True * t(3) by (metis Un_iff term.order_refl insertE)+ 
+          using \<theta> \<theta>_dom True * t(3) by (metis Un_iff term.order_refl insertE)+
         hence "y \<noteq> x" "z \<noteq> x" using x_dom by auto
         hence "\<theta> y = \<sigma> y" "\<theta> z = \<sigma> z" using \<theta> by auto
         thus ?thesis using \<open>\<theta> y = \<theta> z\<close> \<sigma>(2) ** unfolding bij_betw_def inj_on_def by auto
       qed (metis \<theta> * \<open>\<theta> y = \<theta> z\<close> \<theta>_dom ground_imgs(1) ground_subst_dom_iff_img insertE)
     }
     thus "(\<theta> y = \<theta> z) = (y = z)" by auto
   next
     fix y assume "y \<in> subst_domain \<theta>" thus "\<theta> y \<in> subst_range \<theta>" by auto
   next
     fix t assume "t \<in> subst_range \<theta>" thus "\<exists>z \<in> subst_domain \<theta>. t = \<theta> z" by auto
   qed
   moreover have "subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \<theta>) \<subseteq> {t. {} \<turnstile>\<^sub>c t}  - T"
   proof -
     { fix s assume "s \<sqsubseteq> t"
       hence "s \<in> {t. {} \<turnstile>\<^sub>c t}  - T"
-        using t(2,3) 
+        using t(2,3)
         by (metis Diff_eq_empty_iff Diff_iff Un_upper1 term.order_refl
-                  deduct_synth_subterm mem_Collect_eq) 
+                  deduct_synth_subterm mem_Collect_eq)
     } thus ?thesis using \<sigma>(3) \<theta> \<theta>_img by auto
   qed
   moreover have "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>" using \<theta> t(1) \<sigma>(5) unfolding wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def by auto
   moreover have "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>)"
     using \<theta> \<sigma>(6) t(2) pgwt_is_empty_synth pgwt_wellformed
           wf_trm_subst_range_iff[of \<sigma>] wf_trm_subst_range_iff[of \<theta>]
     by metis
   moreover have "\<forall>s\<in>subst_range \<theta>. \<forall>u\<in>subst_range \<theta>. (\<exists>v. v \<sqsubseteq> s \<and> v \<sqsubseteq> u) \<longrightarrow> s = u"
     using \<sigma>(4) \<theta>_img t(3) by (auto simp del: subst_range.simps)
   ultimately show ?case by blast
 qed
 
 private lemma wt_bij_finite_tatom_subst_exists_single:
   assumes "finite (S::'var set)" "finite (T::('fun,'var) terms)"
   and "\<And>x. x \<in> S \<Longrightarrow> \<Gamma> (Var x) = TAtom a"
   shows "\<exists>\<sigma>::('fun,'var) subst. subst_domain \<sigma> = S
                       \<and> bij_betw \<sigma> (subst_domain \<sigma>) (subst_range \<sigma>)
                       \<and> subst_range \<sigma> \<subseteq> ((\<lambda>c. Fun c []) `  {c. \<Gamma> (Fun c []) = TAtom a \<and>
                                                             public c \<and> arity c = 0}) - T
                       \<and> wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<sigma>
                       \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<sigma>)"
 proof -
   let ?U = "{c. \<Gamma> (Fun c []) = TAtom a \<and> public c \<and> arity c = 0}"
 
   obtain \<sigma> where \<sigma>:
       "subst_domain \<sigma> = S" "bij_betw \<sigma> (subst_domain \<sigma>) (subst_range \<sigma>)"
       "subst_range \<sigma> \<subseteq> ((\<lambda>c. Fun c []) ` ?U) - T"
     using bij_finite_const_subst_exists'[OF assms(1,2) infinite_typed_consts'[of a]]
     by auto
 
   { fix x assume "x \<notin> subst_domain \<sigma>" hence "\<Gamma> (Var x) = \<Gamma> (\<sigma> x)" by auto }
   moreover
   { fix x assume "x \<in> subst_domain \<sigma>"
     hence "\<exists>c \<in> ?U. \<sigma> x = Fun c [] \<and> arity c = 0" using \<sigma> by auto
     hence "\<Gamma> (\<sigma> x) = TAtom a" "wf\<^sub>t\<^sub>r\<^sub>m (\<sigma> x)" using assms(3) const_type wf_trmI[of "[]"] by auto
     hence "\<Gamma> (Var x) = \<Gamma> (\<sigma> x)" "wf\<^sub>t\<^sub>r\<^sub>m (\<sigma> x)" using assms(3) \<sigma>(1) by force+
   }
   ultimately have "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<sigma>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<sigma>)"
     using wf_trm_subst_range_iff[of \<sigma>]
     unfolding wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def
     by force+
   thus ?thesis using \<sigma> by auto
 qed
 
 lemma wt_bij_finite_tatom_subst_exists:
   assumes "finite (S::'var set)" "finite (T::('fun,'var) terms)"
   and "\<And>x. x \<in> S \<Longrightarrow> \<exists>a. \<Gamma> (Var x) = TAtom a"
   shows "\<exists>\<sigma>::('fun,'var) subst. subst_domain \<sigma> = S
                       \<and> bij_betw \<sigma> (subst_domain \<sigma>) (subst_range \<sigma>)
                       \<and> subst_range \<sigma> \<subseteq> ((\<lambda>c. Fun c []) `  \<C>\<^sub>p\<^sub>u\<^sub>b) - T
                       \<and> wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<sigma>
                       \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<sigma>)"
 using assms
 proof (induction rule: finite_induct)
   case empty
   have "subst_domain Var = {}"
        "bij_betw Var (subst_domain Var) (subst_range Var)"
        "subst_range Var \<subseteq> ((\<lambda>c. Fun c []) `  \<C>\<^sub>p\<^sub>u\<^sub>b) - T"
        "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t Var"
        "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range Var)"
     unfolding bij_betw_def
     by auto
   thus ?case by (auto simp add: subst_domain_def)
 next
   case (insert x S)
   then obtain a where a: "\<Gamma> (Var x) = TAtom a" by fastforce
 
   from insert obtain \<sigma> where \<sigma>:
       "subst_domain \<sigma> = S" "bij_betw \<sigma> (subst_domain \<sigma>) (subst_range \<sigma>)"
       "subst_range \<sigma> \<subseteq> ((\<lambda>c. Fun c []) `  \<C>\<^sub>p\<^sub>u\<^sub>b) - T" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<sigma>"
       "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<sigma>)"
     by auto
 
   let ?S' = "{y \<in> S. \<Gamma> (Var y) = TAtom a}"
   let ?T' = "T \<union> subst_range \<sigma>"
 
   have *: "finite (insert x ?S')" using insert by simp
   have **: "finite ?T'" using insert.prems(1) insert.hyps(1) \<sigma>(1) by simp
   have ***: "\<And>y. y \<in> insert x ?S' \<Longrightarrow> \<Gamma> (Var y) = TAtom a" using a by auto
 
   obtain \<delta> where \<delta>:
       "subst_domain \<delta> = insert x ?S'" "bij_betw \<delta> (subst_domain \<delta>) (subst_range \<delta>)"
       "subst_range \<delta> \<subseteq> ((\<lambda>c. Fun c []) `  \<C>\<^sub>p\<^sub>u\<^sub>b) - ?T'" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<delta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<delta>)"
     using wt_bij_finite_tatom_subst_exists_single[OF * ** ***] const_type_inv[of _ "[]" a]
     by blast
 
   obtain \<theta> where \<theta>: "\<theta> \<equiv> \<lambda>y. if x = y then \<delta> y else \<sigma> y" by simp
 
   have x_dom: "x \<notin> subst_domain \<sigma>" "x \<in> subst_domain \<delta>" "x \<in> subst_domain \<theta>"
     using insert.hyps(2) \<sigma>(1) \<delta>(1) \<theta> by (auto simp add: subst_domain_def)
   moreover have ground_imgs: "ground (subst_range \<sigma>)" "ground (subst_range \<delta>)"
     using pgwt_ground \<sigma>(3) \<delta>(3) by auto
   ultimately have x_img: "\<sigma> x \<notin> subst_range \<sigma>" "\<delta> x \<in> subst_range \<delta>"
     using ground_subst_dom_iff_img by (auto simp add: subst_domain_def)
 
   have "ground (insert (\<delta> x) (subst_range \<sigma>))" using ground_imgs x_dom by auto
   have \<theta>_dom: "subst_domain \<theta> = insert x (subst_domain \<sigma>)"
     using \<delta>(1) \<theta> by (auto simp add: subst_domain_def)
   have \<theta>_img: "subst_range \<theta> = insert (\<delta> x) (subst_range \<sigma>)"
   proof
     show "subst_range \<theta> \<subseteq> insert (\<delta> x) (subst_range \<sigma>)"
     proof
       fix t assume "t \<in> subst_range \<theta>"
       then obtain y where "y \<in> subst_domain \<theta>" "t = \<theta> y" by auto
       thus "t \<in> insert (\<delta> x) (subst_range \<sigma>)" using \<theta> by (auto simp add: subst_domain_def)
     qed
     show "insert (\<delta> x) (subst_range \<sigma>) \<subseteq> subst_range \<theta>"
     proof
       fix t assume t: "t \<in> insert (\<delta> x) (subst_range \<sigma>)"
       hence "fv t = {}" using ground_imgs x_img(2) by auto
       hence "t \<noteq> Var x" by auto
       show "t \<in> subst_range \<theta>"
       proof (cases "t = \<delta> x")
         case True thus ?thesis using subst_imgI \<theta> \<open>t \<noteq> Var x\<close> by metis
       next
         case False
         hence "t \<in> subst_range \<sigma>" using t by auto
         then obtain y where "\<sigma> y \<in> subst_range \<sigma>" "t = \<sigma> y" by auto
         hence "y \<in> subst_domain \<sigma>" "t \<noteq> Var y"
           using ground_subst_dom_iff_img[OF ground_imgs(1)]
           by (auto simp add: subst_domain_def simp del: subst_range.simps)
         hence "x \<noteq> y" using x_dom by auto
         hence "\<theta> y = \<sigma> y" unfolding \<theta> by auto
         thus ?thesis using \<open>t \<noteq> Var y\<close> \<open>t = \<sigma> y\<close> subst_imgI[of \<theta> y] by auto
       qed
     qed
   qed
   hence \<theta>_ground_img: "ground (subst_range \<theta>)" using ground_imgs x_img by auto
 
   have "subst_domain \<theta> = insert x S" using \<theta>_dom \<sigma>(1) by auto
   moreover have "bij_betw \<theta> (subst_domain \<theta>) (subst_range \<theta>)"
   proof (intro bij_betwI')
     fix y z assume *: "y \<in> subst_domain \<theta>" "z \<in> subst_domain \<theta>"
     hence "fv (\<theta> y) = {}" "fv (\<theta> z) = {}" using \<theta>_ground_img by auto
     { assume "\<theta> y = \<theta> z" hence "y = z"
       proof (cases "\<theta> y \<in> subst_range \<sigma> \<and> \<theta> z \<in> subst_range \<sigma>")
         case True
         hence **: "y \<in> subst_domain \<sigma>" "z \<in> subst_domain \<sigma>"
           using \<theta> \<theta>_dom x_img(2) \<delta>(3) True
           by (metis (no_types) *(1) DiffE Un_upper2 insertE subsetCE,
               metis (no_types) *(2) DiffE Un_upper2 insertE subsetCE)
         hence "y \<noteq> x" "z \<noteq> x" using x_dom by auto
         hence "\<theta> y = \<sigma> y" "\<theta> z = \<sigma> z" using \<theta> by auto
         thus ?thesis using \<open>\<theta> y = \<theta> z\<close> \<sigma>(2) ** unfolding bij_betw_def inj_on_def by auto
       qed (metis \<theta> * \<open>\<theta> y = \<theta> z\<close> \<theta>_dom ground_imgs(1) ground_subst_dom_iff_img insertE)
     }
     thus "(\<theta> y = \<theta> z) = (y = z)" by auto
   next
     fix y assume "y \<in> subst_domain \<theta>" thus "\<theta> y \<in> subst_range \<theta>" by auto
   next
     fix t assume "t \<in> subst_range \<theta>" thus "\<exists>z \<in> subst_domain \<theta>. t = \<theta> z" by auto
   qed
   moreover have "subst_range \<theta> \<subseteq> (\<lambda>c. Fun c []) ` \<C>\<^sub>p\<^sub>u\<^sub>b - T"
     using \<sigma>(3) \<delta>(3) \<theta> by (auto simp add: subst_domain_def)
   moreover have "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>" using \<sigma>(4) \<delta>(4) \<theta> unfolding wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def by auto
   moreover have "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>)"
     using \<theta> \<sigma>(5) \<delta>(5) wf_trm_subst_range_iff[of \<delta>]
           wf_trm_subst_range_iff[of \<sigma>] wf_trm_subst_range_iff[of \<theta>]
     by presburger
   ultimately show ?case by blast
 qed
 
 theorem wt_sat_if_simple:
   assumes "simple S" "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S \<theta>" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t S)"
   and \<I>': "\<forall>X F. Inequality X F \<in> set S \<longrightarrow> ineq_model \<I>' X F"
          "ground (subst_range \<I>')"
          "subst_domain \<I>' = {x \<in> vars\<^sub>s\<^sub>t S. \<exists>X F. Inequality X F \<in> set S \<and> x \<in> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X}"
   and tfr_stp_all: "list_all tfr\<^sub>s\<^sub>t\<^sub>p S"
   shows "\<exists>\<I>. interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I> \<and> (\<I> \<Turnstile>\<^sub>c \<langle>S, \<theta>\<rangle>) \<and> wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I> \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<I>)"
 proof -
   from \<open>wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S \<theta>\<close> have "wf\<^sub>s\<^sub>t {} S" "subst_idem \<theta>" and S_\<theta>_disj: "\<forall>v \<in> vars\<^sub>s\<^sub>t S. \<theta> v = Var v"
     using subst_idemI[of \<theta>] unfolding wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r_def wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def by force+
-  
+
   obtain \<I>::"('fun,'var) subst"
     where \<I>: "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>" "subst_range \<I> \<subseteq> public_ground_wf_terms"
     using wt_interpretation_exists by blast
   hence \<I>_deduct: "\<And>x M. M \<turnstile>\<^sub>c \<I> x" and \<I>_wf_trm: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<I>)"
     using pgwt_deducible pgwt_wellformed by fastforce+
 
   let ?P = "\<lambda>\<delta> X. subst_domain \<delta> = set X \<and> ground (subst_range \<delta>)"
   let ?Sineqsvars = "{x \<in> vars\<^sub>s\<^sub>t S. \<exists>X F. Inequality X F \<in> set S \<and> x \<in> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \<and> x \<notin> set X}"
   let ?Strms = "subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t S)"
 
   have finite_vars: "finite ?Sineqsvars" "finite ?Strms" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s ?Strms"
     using wf_trm_subtermeq assms(5) by fastforce+
 
   define Q1 where "Q1 = (\<lambda>(F::(('fun,'var) term \<times> ('fun,'var) term) list) X.
     \<forall>x \<in> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X. \<exists>a. \<Gamma> (Var x) = TAtom a)"
 
   define Q2 where "Q2 = (\<lambda>(F::(('fun,'var) term \<times> ('fun,'var) term) list) X.
     \<forall>f T. Fun f T \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F) \<longrightarrow> T = [] \<or> (\<exists>s \<in> set T. s \<notin> Var ` set X))"
 
   define Q1' where "Q1' = (\<lambda>(t::('fun,'var) term) (t'::('fun,'var) term) X.
     \<forall>x \<in> (fv t \<union> fv t') - set X. \<exists>a. \<Gamma> (Var x) = TAtom a)"
 
   define Q2' where "Q2' = (\<lambda>(t::('fun,'var) term) (t'::('fun,'var) term) X.
     \<forall>f T. Fun f T \<in> subterms t \<union> subterms t' \<longrightarrow> T = [] \<or> (\<exists>s \<in> set T. s \<notin> Var ` set X))"
 
   have ex_P: "\<forall>X. \<exists>\<delta>. ?P \<delta> X" using interpretation_subst_exists' by blast
 
   have tfr_ineq: "\<forall>X F. Inequality X F \<in> set S \<longrightarrow> Q1 F X \<or> Q2 F X"
     using tfr_stp_all Q1_def Q2_def tfr\<^sub>s\<^sub>t\<^sub>p_list_all_alt_def[of S] by blast
 
   have S_fv_bvars_disj: "fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>s\<^sub>t S = {}" using \<open>wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S \<theta>\<close> unfolding wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r_def by metis
   hence ineqs_vars_not_bound: "\<forall>X F x. Inequality X F \<in> set S \<longrightarrow> x \<in> ?Sineqsvars \<longrightarrow> x \<notin> set X"
     using strand_fv_bvars_disjoint_unfold by blast
 
   have \<theta>_vars_S_bvars_disj: "(subst_domain \<theta> \<union> range_vars \<theta>) \<inter> set X = {}"
     when "Inequality X F \<in> set S" for F X
     using wf_constr_bvars_disj[OF \<open>wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S \<theta>\<close>]
           strand_fv_bvars_disjointD(1)[OF S_fv_bvars_disj that]
     by blast
 
   obtain \<sigma>::"('fun,'var) subst"
     where \<sigma>_fv_dom: "subst_domain \<sigma> = ?Sineqsvars"
     and \<sigma>_subterm_inj: "subterm_inj_on \<sigma> (subst_domain \<sigma>)"
     and \<sigma>_fresh_pub_img: "subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \<sigma>) \<subseteq> {t. {} \<turnstile>\<^sub>c t} - ?Strms"
     and \<sigma>_wt: "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<sigma>"
     and \<sigma>_wf_trm: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<sigma>)"
     using wt_bij_finite_subst_exists[OF finite_vars]
           subst_inj_on_is_bij_betw subterm_inj_on_alt_def'
     by moura
 
   have \<sigma>_bij_dom_img: "bij_betw \<sigma> (subst_domain \<sigma>) (subst_range \<sigma>)"
     by (metis \<sigma>_subterm_inj subst_inj_on_is_bij_betw subterm_inj_on_alt_def)
 
   have "finite (subst_domain \<sigma>)" by(metis \<sigma>_fv_dom finite_vars(1))
-  hence \<sigma>_finite_img: "finite (subst_range \<sigma>)" using \<sigma>_bij_dom_img bij_betw_finite by blast 
-  
+  hence \<sigma>_finite_img: "finite (subst_range \<sigma>)" using \<sigma>_bij_dom_img bij_betw_finite by blast
+
   have \<sigma>_img_subterms: "\<forall>s \<in> subst_range \<sigma>. \<forall>u \<in> subst_range \<sigma>. (\<exists>v. v \<sqsubseteq> s \<and> v \<sqsubseteq> u) \<longrightarrow> s = u"
     by (metis \<sigma>_subterm_inj subterm_inj_on_alt_def')
 
   have "subst_range \<sigma> \<subseteq> subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \<sigma>)" by auto
   hence "subst_range \<sigma> \<subseteq> public_ground_wf_terms - ?Strms"
       and \<sigma>_pgwt_img:
         "subst_range \<sigma> \<subseteq> public_ground_wf_terms"
         "subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \<sigma>) \<subseteq> public_ground_wf_terms"
     using \<sigma>_fresh_pub_img pgwt_is_empty_synth by blast+
 
   have \<sigma>_img_ground: "ground (subst_range \<sigma>)"
     using \<sigma>_pgwt_img pgwt_ground by auto
   hence \<sigma>_inj: "inj \<sigma>"
     using \<sigma>_bij_dom_img subst_inj_is_bij_betw_dom_img_if_ground_img by auto
 
   have \<sigma>_ineqs_fv_dom: "\<And>X F. Inequality X F \<in> set S \<Longrightarrow> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X \<subseteq> subst_domain \<sigma>"
     using \<sigma>_fv_dom by fastforce
 
   have \<sigma>_dom_bvars_disj: "\<forall>X F. Inequality X F \<in> set S \<longrightarrow> subst_domain \<sigma> \<inter> set X = {}"
     using ineqs_vars_not_bound \<sigma>_fv_dom by fastforce
-  
+
   have \<I>'1: "\<forall>X F \<delta>. Inequality X F \<in> set S \<longrightarrow> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X \<subseteq> subst_domain \<I>'"
     using \<I>'(3) ineqs_vars_not_bound by fastforce
-  
+
   have \<I>'2: "\<forall>X F. Inequality X F \<in> set S \<longrightarrow> subst_domain \<I>' \<inter> set X = {}"
     using \<I>'(3) ineqs_vars_not_bound by blast
-  
+
   have doms_eq: "subst_domain \<I>' = subst_domain \<sigma>" using \<I>'(3) \<sigma>_fv_dom by simp
 
   have \<sigma>_ineqs_neq: "ineq_model \<sigma> X F" when "Inequality X F \<in> set S" for X F
   proof -
     obtain a::"'fun" where a: "a \<notin> \<Union>(funs_term ` subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \<sigma>))"
       using exists_fun_notin_funs_terms[OF subterms_union_finite[OF \<sigma>_finite_img]]
       by moura
     hence a': "\<And>T. Fun a T \<notin> subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \<sigma>)"
               "\<And>S. Fun a [] \<in> set (Fun a []#S)" "Fun a [] \<notin> Var ` set X"
       by (meson a UN_I term.set_intros(1), auto)
 
     define t where "t \<equiv> Fun a (Fun a []#map fst F)"
     define t' where "t' \<equiv> Fun a (Fun a []#map snd F)"
 
     note F_in = that
 
     have t_fv: "fv t \<union> fv t' \<subseteq> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F"
       unfolding t_def t'_def by force
 
     have t_subterms: "subterms t \<union> subterms t' \<subseteq> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F) \<union> {t, t', Fun a []}"
       unfolding t_def t'_def by force
 
     have "t \<cdot> \<delta> \<cdot> \<sigma> \<noteq> t' \<cdot> \<delta> \<cdot> \<sigma>" when "?P \<delta> X" for \<delta>
     proof -
       have tfr_assms: "Q1 F X \<or> Q2 F X" using tfr_ineq F_in by metis
-  
+
       have "Q1 F X \<Longrightarrow> \<forall>x \<in> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X. \<exists>c. \<sigma> x = Fun c []"
       proof
         fix x assume "Q1 F X" and x: "x \<in> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X"
         then obtain a where "\<Gamma> (Var x) = TAtom a" unfolding Q1_def by moura
         hence a: "\<Gamma> (\<sigma> x) = TAtom a" using \<sigma>_wt unfolding wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def by simp
-        
+
         have "x \<in> subst_domain \<sigma>" using \<sigma>_ineqs_fv_dom x F_in by auto
         then obtain f T where fT: "\<sigma> x = Fun f T" by (meson \<sigma>_img_ground ground_img_obtain_fun)
         hence "T = []" using \<sigma>_wf_trm a TAtom_term_cases by fastforce
         thus "\<exists>c. \<sigma> x = Fun c []" using fT by metis
       qed
       hence 1: "Q1 F X \<Longrightarrow> \<forall>x \<in> (fv t \<union> fv t') - set X. \<exists>c. \<sigma> x = Fun c []"
         using t_fv by auto
-  
+
       have 2: "\<not>Q1 F X \<Longrightarrow> Q2 F X" by (metis tfr_assms)
-  
+
       have 3: "subst_domain \<sigma> \<inter> set X = {}" using \<sigma>_dom_bvars_disj F_in by auto
 
       have 4: "subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \<sigma>) \<inter> (subterms t \<union> subterms t') = {}"
       proof -
         define M1 where "M1 \<equiv> {t, t', Fun a []}"
         define M2 where "M2 \<equiv> ?Strms"
 
         have "subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F) \<subseteq> M2"
           using F_in unfolding M2_def by force
         moreover have "subterms t \<union> subterms t' \<subseteq> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F) \<union> M1"
           using t_subterms unfolding M1_def by blast
         ultimately have *: "subterms t \<union> subterms t' \<subseteq> M2 \<union> M1"
           by auto
 
         have "subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \<sigma>) \<inter> M1 = {}"
              "subterms\<^sub>s\<^sub>e\<^sub>t (subst_range \<sigma>) \<inter> M2 = {}"
           using a' \<sigma>_fresh_pub_img
           unfolding t_def t'_def M1_def M2_def
           by blast+
         thus ?thesis using * by blast
       qed
-  
+
       have 5: "(fv t \<union> fv t') - subst_domain \<sigma> \<subseteq> set X"
         using \<sigma>_ineqs_fv_dom[OF F_in] t_fv
         by auto
-  
+
       have 6: "\<forall>\<delta>. ?P \<delta> X \<longrightarrow> t \<cdot> \<delta> \<cdot> \<I>' \<noteq> t' \<cdot> \<delta> \<cdot> \<I>'"
         by (metis t_def t'_def \<I>'(1) F_in ineq_model_singleE ineq_model_single_iff)
-  
+
       have 7: "fv t \<union> fv t' - set X \<subseteq> subst_domain \<I>'" using \<I>'1 F_in t_fv by force
-  
+
       have 8: "subst_domain \<I>' \<inter> set X = {}" using \<I>'2 F_in by auto
 
       have 9: "Q1' t t' X" when "Q1 F X"
         using that t_fv
         unfolding Q1_def Q1'_def t_def t'_def
         by blast
 
       have 10: "Q2' t t' X" when "Q2 F X" unfolding Q2'_def
       proof (intro allI impI)
         fix f T assume "Fun f T \<in> subterms t \<union> subterms t'"
         moreover {
           assume "Fun f T \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F)"
           hence "T = [] \<or> (\<exists>s\<in>set T. s \<notin> Var ` set X)" by (metis Q2_def that)
         } moreover {
           assume "Fun f T = t" hence "T = [] \<or> (\<exists>s\<in>set T. s \<notin> Var ` set X)"
             unfolding t_def using a'(2,3) by simp
         } moreover {
           assume "Fun f T = t'" hence "T = [] \<or> (\<exists>s\<in>set T. s \<notin> Var ` set X)"
             unfolding t'_def using a'(2,3) by simp
         } moreover {
           assume "Fun f T = Fun a []" hence "T = [] \<or> (\<exists>s\<in>set T. s \<notin> Var ` set X)" by simp
         } ultimately show "T = [] \<or> (\<exists>s\<in>set T. s \<notin> Var ` set X)" using t_subterms by blast
       qed
 
       note 11 = \<sigma>_subterm_inj \<sigma>_img_ground 3 4 5
-  
+
       note 12 = 6 7 8 \<I>'(2) doms_eq
-  
+
       show "t \<cdot> \<delta> \<cdot> \<sigma> \<noteq> t' \<cdot> \<delta> \<cdot> \<sigma>"
-        using 1 2 9 10 that sat_ineq_subterm_inj_subst[OF 11 _ 12] 
+        using 1 2 9 10 that sat_ineq_subterm_inj_subst[OF 11 _ 12]
         unfolding Q1'_def Q2'_def by metis
     qed
     thus ?thesis by (metis t_def t'_def ineq_model_singleI ineq_model_single_iff)
   qed
 
   have \<sigma>_ineqs_fv_dom': "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<delta>) \<subseteq> subst_domain \<sigma>"
     when "Inequality X F \<in> set S" and "?P \<delta> X" for F \<delta> X
     using \<sigma>_ineqs_fv_dom[OF that(1)]
   proof (induction F)
     case (Cons g G)
     obtain t t' where g: "g = (t,t')" by (metis surj_pair)
     hence "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (g#G \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<delta>)  = fv (t \<cdot> \<delta>) \<union> fv (t' \<cdot> \<delta>) \<union> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (G \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<delta>)"
           "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (g#G) = fv t \<union> fv t' \<union> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s G"
       by (simp_all add: subst_apply_pairs_def)
     moreover have "fv (t \<cdot> \<delta>) = fv t - subst_domain \<delta>" "fv (t' \<cdot> \<delta>) = fv t' - subst_domain \<delta>"
       using g that(2) by (simp_all add: subst_fv_unfold_ground_img range_vars_alt_def)
     moreover have "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (G \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<delta>) \<subseteq> subst_domain \<sigma>" using Cons by auto
     ultimately show ?case using Cons.prems that(2) by auto
   qed (simp add: subst_apply_pairs_def)
 
   have \<sigma>_ineqs_ground: "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s ((F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<delta>) \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<sigma>) = {}"
     when "Inequality X F \<in> set S" and "?P \<delta> X" for F \<delta> X
     using \<sigma>_ineqs_fv_dom'[OF that]
   proof (induction F)
     case (Cons g G)
     obtain t t' where g: "g = (t,t')" by (metis surj_pair)
     hence "fv (t \<cdot> \<delta>) \<subseteq> subst_domain \<sigma>" "fv (t' \<cdot> \<delta>) \<subseteq> subst_domain \<sigma>"
       using Cons.prems by (auto simp add: subst_apply_pairs_def)
     hence "fv (t \<cdot> \<delta> \<cdot> \<sigma>) = {}" "fv (t' \<cdot> \<delta> \<cdot> \<sigma>) = {}"
       using subst_fv_dom_ground_if_ground_img[OF _ \<sigma>_img_ground] by metis+
     thus ?case using g Cons by (auto simp add: subst_apply_pairs_def)
   qed (simp add: subst_apply_pairs_def)
- 
+
   from \<sigma>_pgwt_img \<sigma>_ineqs_neq have \<sigma>_deduct: "M \<turnstile>\<^sub>c \<sigma> x" when "x \<in> subst_domain \<sigma>" for x M
     using that pgwt_deducible by fastforce
 
   { fix M::"('fun,'var) terms"
     have "\<lbrakk>M; S\<rbrakk>\<^sub>c (\<theta> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<I>)"
       using \<open>wf\<^sub>s\<^sub>t {} S\<close> \<open>simple S\<close> S_\<theta>_disj \<sigma>_ineqs_neq \<sigma>_ineqs_fv_dom' \<theta>_vars_S_bvars_disj
     proof (induction S arbitrary: M rule: wf\<^sub>s\<^sub>t_simple_induct)
       case (ConsSnd v S)
       hence S_sat: "\<lbrakk>M; S\<rbrakk>\<^sub>c (\<theta> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<I>)" and "\<theta> v = Var v" by auto
       hence "\<And>M. M \<turnstile>\<^sub>c Var v \<cdot> (\<theta> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<I>)"
         using \<I>_deduct \<sigma>_deduct
         by (metis ideduct_synth_subst_apply subst_apply_term.simps(1)
-                  subst_subst_compose trm_subst_ident') 
+                  subst_subst_compose trm_subst_ident')
       thus ?case using strand_sem_append(1)[OF S_sat] by (metis strand_sem_c.simps(1,2))
     next
       case (ConsIneq X F S)
       have dom_disj: "subst_domain \<theta> \<inter> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F = {}"
         using ConsIneq.prems(1) subst_dom_vars_in_subst
         by force
       hence *: "F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<theta> = F" by blast
 
       have **: "ineq_model \<sigma> X F" by (meson ConsIneq.prems(2) in_set_conv_decomp)
 
       have "\<And>x. x \<in> vars\<^sub>s\<^sub>t S \<Longrightarrow> x \<in> vars\<^sub>s\<^sub>t (S@[Inequality X F])"
            "\<And>x. x \<in> set S \<Longrightarrow> x \<in> set (S@[Inequality X F])" by auto
       hence IH: "\<lbrakk>M; S\<rbrakk>\<^sub>c (\<theta> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<I>)" by (metis ConsIneq.IH ConsIneq.prems(1,2,3,4))
 
       have "ineq_model (\<sigma> \<circ>\<^sub>s \<I>) X F"
       proof -
         have "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<delta>) \<subseteq> subst_domain \<sigma>" when "?P \<delta> X" for \<delta>
           using ConsIneq.prems(3)[OF _ that] by simp
         hence "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X \<subseteq> subst_domain \<sigma>"
           using fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s_subst_subset ex_P
           by (metis Diff_subset_conv Un_commute)
         thus ?thesis by (metis ineq_model_ground_subst[OF _ \<sigma>_img_ground **])
       qed
       hence "ineq_model (\<theta> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<I>) X F"
         using * ineq_model_subst' subst_compose_assoc ConsIneq.prems(4)
         by (metis UnCI list.set_intros(1) set_append)
       thus ?case using IH by (auto simp add: ineq_model_def)
     qed auto
   }
   moreover have "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t (\<theta> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<I>)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range (\<theta> \<circ>\<^sub>s \<sigma> \<circ>\<^sub>s \<I>))"
     by (metis wt_subst_compose \<open>wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>\<close> \<open>wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<sigma>\<close> \<open>wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>\<close>,
         metis assms(4) \<I>_wf_trm \<sigma>_wf_trm wf_trm_subst subst_img_comp_subset')
   ultimately show ?thesis
     using interpretation_comp(1)[OF \<open>interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>\<close>, of "\<theta> \<circ>\<^sub>s \<sigma>"]
           subst_idem_support[OF \<open>subst_idem \<theta>\<close>, of "\<sigma> \<circ>\<^sub>s \<I>"] subst_compose_assoc
     unfolding constr_sem_c_def by metis
 qed
 end
 
 
 subsubsection \<open>Theorem: Type-flaw resistant constraints are well-typed satisfiable (composition-only)\<close>
 text \<open>
   There exists well-typed models of satisfiable type-flaw resistant constraints in the
   semantics where the intruder is limited to composition only (i.e., he cannot perform
   decomposition/analysis of deducible messages).
 \<close>
 theorem wt_attack_if_tfr_attack:
   assumes "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>"
     and "\<I> \<Turnstile>\<^sub>c \<langle>S, \<theta>\<rangle>"
     and "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S \<theta>"
     and "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>"
     and "tfr\<^sub>s\<^sub>t S"
     and "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t S)"
     and "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>)"
   obtains \<I>\<^sub>\<tau> where "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>\<^sub>\<tau>"
     and "\<I>\<^sub>\<tau> \<Turnstile>\<^sub>c \<langle>S, \<theta>\<rangle>"
     and "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>\<^sub>\<tau>"
     and "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<I>\<^sub>\<tau>)"
 proof -
   have tfr: "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t S)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t S)" "list_all tfr\<^sub>s\<^sub>t\<^sub>p S"
     using assms(5,6) unfolding tfr\<^sub>s\<^sub>t_def by metis+
   obtain S' \<theta>' where *: "simple S'" "(S,\<theta>) \<leadsto>\<^sup>* (S',\<theta>')" "\<lbrakk>{}; S'\<rbrakk>\<^sub>c \<I>"
     using LI_completeness[OF assms(3,2)] unfolding constr_sem_c_def
     by (meson term.order_refl)
-  have **: "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S' \<theta>'" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>'" "list_all tfr\<^sub>s\<^sub>t\<^sub>p S'" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t S')" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>')" 
+  have **: "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S' \<theta>'" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>'" "list_all tfr\<^sub>s\<^sub>t\<^sub>p S'" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t S')" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>')"
     using LI_preserves_welltypedness[OF *(2) assms(3,4,7) tfr]
           LI_preserves_wellformedness[OF *(2) assms(3)]
           LI_preserves_tfr[OF *(2) assms(3,4,7) tfr]
     by metis+
 
   define A where "A \<equiv> {x \<in> vars\<^sub>s\<^sub>t S'. \<exists>X F. Inequality X F \<in> set S' \<and> x \<in> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F \<and> x \<notin> set X}"
   define B where "B \<equiv> UNIV - A"
 
   let ?\<I> = "rm_vars B \<I>"
 
   have gr\<I>: "ground (subst_range \<I>)" "ground (subst_range ?\<I>)"
     using assms(1) rm_vars_img_subset[of B \<I>] by (auto simp add: subst_domain_def)
 
   { fix X F
     assume "Inequality X F \<in> set S'"
     hence *: "ineq_model \<I> X F"
       using strand_sem_c_imp_ineq_model[OF *(3)]
       by (auto simp del: subst_range.simps)
     hence "ineq_model ?\<I> X F"
     proof -
       { fix \<delta>
         assume 1: "subst_domain \<delta> = set X" "ground (subst_range \<delta>)"
             and 2: "list_ex (\<lambda>f. fst f \<cdot> \<delta> \<circ>\<^sub>s \<I> \<noteq> snd f \<cdot> \<delta> \<circ>\<^sub>s \<I>) F"
         have "list_ex (\<lambda>f. fst f \<cdot> \<delta> \<circ>\<^sub>s rm_vars B \<I> \<noteq> snd f \<cdot> \<delta> \<circ>\<^sub>s rm_vars B \<I>) F" using 2
         proof (induction F)
           case (Cons g G)
           obtain t t' where g: "g = (t,t')" by (metis surj_pair)
           thus ?case
             using Cons Unifier_ground_rm_vars[OF gr\<I>(1), of "t \<cdot> \<delta>" B "t' \<cdot> \<delta>"]
             by auto
         qed simp
       } thus ?thesis using * unfolding ineq_model_def by simp
     qed
   } moreover have "subst_domain \<I> = UNIV" using assms(1) by metis
   hence "subst_domain ?\<I> = A" using rm_vars_dom[of B \<I>] B_def by blast
   ultimately obtain \<I>\<^sub>\<tau> where
       "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>\<^sub>\<tau>" "\<I>\<^sub>\<tau> \<Turnstile>\<^sub>c \<langle>S', \<theta>'\<rangle>" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>\<^sub>\<tau>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<I>\<^sub>\<tau>)"
     using wt_sat_if_simple[OF *(1) **(1,2,5,4) _ gr\<I>(2) _ **(3)] A_def
     by (auto simp del: subst_range.simps)
   thus ?thesis using that LI_soundness[OF assms(3) *(2)] by metis
 qed
 
 text \<open>
   Contra-positive version: if a type-flaw resistant constraint does not have a well-typed model
   then it is unsatisfiable
 \<close>
 corollary secure_if_wt_secure:
   assumes "\<not>(\<exists>\<I>\<^sub>\<tau>. interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>\<^sub>\<tau> \<and> (\<I>\<^sub>\<tau> \<Turnstile>\<^sub>c \<langle>S, \<theta>\<rangle>) \<and> wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>\<^sub>\<tau>)"
   and     "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r S \<theta>" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<theta>" "tfr\<^sub>s\<^sub>t S"
   and     "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t S)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<theta>)"
   shows "\<not>(\<exists>\<I>. interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I> \<and> (\<I> \<Turnstile>\<^sub>c \<langle>S, \<theta>\<rangle>))"
 using wt_attack_if_tfr_attack[OF _ _ assms(2,3,4,5,6)] assms(1) by metis
 
 end
 
 
 subsection \<open>Lifting the Composition-Only Typing Result to the Full Intruder Model\<close>
 context typed_model
 begin
 
 subsubsection \<open>Analysis Invariance\<close>
 definition (in typed_model) Ana_invar_subst where
   "Ana_invar_subst \<M> \<equiv>
     (\<forall>f T K M \<delta>. Fun f T \<in> (subterms\<^sub>s\<^sub>e\<^sub>t \<M>) \<longrightarrow>
                  Ana (Fun f T) = (K, M) \<longrightarrow> Ana (Fun f T \<cdot> \<delta>) = (K \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>, M \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<delta>))"
 
 lemma (in typed_model) Ana_invar_subst_subset:
   assumes "Ana_invar_subst M" "N \<subseteq> M"
   shows "Ana_invar_subst N"
 using assms unfolding Ana_invar_subst_def by blast
 
 lemma (in typed_model) Ana_invar_substD:
   assumes "Ana_invar_subst \<M>"
   and "Fun f T \<in> subterms\<^sub>s\<^sub>e\<^sub>t \<M>" "Ana (Fun f T) = (K, M)"
   shows "Ana (Fun f T \<cdot> \<I>) = (K \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<I>, M \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<I>)"
 using assms Ana_invar_subst_def by blast
 
 end
 
 
 subsubsection \<open>Preliminary Definitions\<close>
 text \<open>Strands extended with "decomposition steps"\<close>
 datatype (funs\<^sub>e\<^sub>s\<^sub>t\<^sub>p: 'a, vars\<^sub>e\<^sub>s\<^sub>t\<^sub>p: 'b) extstrand_step =
   Step   "('a,'b) strand_step"
 | Decomp "('a,'b) term"
 
 context typed_model
 begin
 
 context
 begin
 private fun trms\<^sub>e\<^sub>s\<^sub>t\<^sub>p where
   "trms\<^sub>e\<^sub>s\<^sub>t\<^sub>p (Step x) = trms\<^sub>s\<^sub>t\<^sub>p x"
 | "trms\<^sub>e\<^sub>s\<^sub>t\<^sub>p (Decomp t) = {t}"
 
 private abbreviation trms\<^sub>e\<^sub>s\<^sub>t where "trms\<^sub>e\<^sub>s\<^sub>t S \<equiv> \<Union>(trms\<^sub>e\<^sub>s\<^sub>t\<^sub>p ` set S)"
 
 private type_synonym ('a,'b) extstrand = "('a,'b) extstrand_step list"
 private type_synonym ('a,'b) extstrands = "('a,'b) extstrand set"
 
 private definition decomp::"('fun,'var) term \<Rightarrow> ('fun,'var) strand" where
   "decomp t \<equiv> (case (Ana t) of (K,T) \<Rightarrow> send\<langle>t\<rangle>\<^sub>s\<^sub>t#map Send K@map Receive T)"
 
 private fun to_st where
   "to_st [] = []"
 | "to_st (Step x#S) = x#(to_st S)"
 | "to_st (Decomp t#S) = (decomp t)@(to_st S)"
 
 private fun to_est where
   "to_est [] = []"
 | "to_est (x#S) = Step x#to_est S"
 
 private abbreviation "ik\<^sub>e\<^sub>s\<^sub>t A \<equiv> ik\<^sub>s\<^sub>t (to_st A)"
 private abbreviation "wf\<^sub>e\<^sub>s\<^sub>t V A \<equiv> wf\<^sub>s\<^sub>t V (to_st A)"
 private abbreviation "assignment_rhs\<^sub>e\<^sub>s\<^sub>t A \<equiv> assignment_rhs\<^sub>s\<^sub>t (to_st A)"
 private abbreviation "vars\<^sub>e\<^sub>s\<^sub>t A \<equiv> vars\<^sub>s\<^sub>t (to_st A)"
 private abbreviation "wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t A \<equiv> wfrestrictedvars\<^sub>s\<^sub>t (to_st A)"
 private abbreviation "bvars\<^sub>e\<^sub>s\<^sub>t A \<equiv> bvars\<^sub>s\<^sub>t (to_st A)"
 private abbreviation "fv\<^sub>e\<^sub>s\<^sub>t A \<equiv> fv\<^sub>s\<^sub>t (to_st A)"
 private abbreviation "funs\<^sub>e\<^sub>s\<^sub>t A \<equiv> funs\<^sub>s\<^sub>t (to_st A)"
 
 private definition wf\<^sub>s\<^sub>t\<^sub>s'::"('fun,'var) strands \<Rightarrow> ('fun,'var) extstrand \<Rightarrow> bool" where
   "wf\<^sub>s\<^sub>t\<^sub>s' \<S> \<A> \<equiv> (\<forall>S \<in> \<S>. wf\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t \<A>) (dual\<^sub>s\<^sub>t S)) \<and>
                  (\<forall>S \<in> \<S>. \<forall>S' \<in> \<S>. fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>s\<^sub>t S' = {}) \<and>
                  (\<forall>S \<in> \<S>. fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>e\<^sub>s\<^sub>t \<A> = {}) \<and>
                  (\<forall>S \<in> \<S>. fv\<^sub>s\<^sub>t (to_st \<A>) \<inter> bvars\<^sub>s\<^sub>t S = {})"
 
 private definition wf\<^sub>s\<^sub>t\<^sub>s::"('fun,'var) strands \<Rightarrow> bool" where
   "wf\<^sub>s\<^sub>t\<^sub>s \<S> \<equiv> (\<forall>S \<in> \<S>. wf\<^sub>s\<^sub>t {} (dual\<^sub>s\<^sub>t S)) \<and> (\<forall>S \<in> \<S>. \<forall>S' \<in> \<S>. fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>s\<^sub>t S' = {})"
 
 private inductive well_analyzed::"('fun,'var) extstrand \<Rightarrow> bool" where
   Nil[simp]: "well_analyzed []"
 | Step: "well_analyzed A \<Longrightarrow> well_analyzed (A@[Step x])"
 | Decomp: "\<lbrakk>well_analyzed A; t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t A \<union> assignment_rhs\<^sub>e\<^sub>s\<^sub>t A) - (Var ` \<V>)\<rbrakk>
     \<Longrightarrow> well_analyzed (A@[Decomp t])"
 
 private fun subst_apply_extstrandstep (infix "\<cdot>\<^sub>e\<^sub>s\<^sub>t\<^sub>p" 51) where
   "subst_apply_extstrandstep (Step x) \<theta> = Step (x \<cdot>\<^sub>s\<^sub>t\<^sub>p \<theta>)"
 | "subst_apply_extstrandstep (Decomp t) \<theta> = Decomp (t \<cdot> \<theta>)"
 
 private lemma subst_apply_extstrandstep'_simps[simp]:
   "(Step (send\<langle>t\<rangle>\<^sub>s\<^sub>t)) \<cdot>\<^sub>e\<^sub>s\<^sub>t\<^sub>p \<theta> = Step (send\<langle>t \<cdot> \<theta>\<rangle>\<^sub>s\<^sub>t)"
   "(Step (receive\<langle>t\<rangle>\<^sub>s\<^sub>t)) \<cdot>\<^sub>e\<^sub>s\<^sub>t\<^sub>p \<theta> = Step (receive\<langle>t \<cdot> \<theta>\<rangle>\<^sub>s\<^sub>t)"
   "(Step (\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t)) \<cdot>\<^sub>e\<^sub>s\<^sub>t\<^sub>p \<theta> = Step (\<langle>a: (t \<cdot> \<theta>) \<doteq> (t' \<cdot> \<theta>)\<rangle>\<^sub>s\<^sub>t)"
   "(Step (\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t)) \<cdot>\<^sub>e\<^sub>s\<^sub>t\<^sub>p \<theta> = Step (\<forall>X\<langle>\<or>\<noteq>: (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \<theta>)\<rangle>\<^sub>s\<^sub>t)"
 by simp_all
 
 private lemma vars\<^sub>e\<^sub>s\<^sub>t\<^sub>p_subst_apply_simps[simp]:
   "vars\<^sub>e\<^sub>s\<^sub>t\<^sub>p ((Step (send\<langle>t\<rangle>\<^sub>s\<^sub>t)) \<cdot>\<^sub>e\<^sub>s\<^sub>t\<^sub>p \<theta>) = fv (t \<cdot> \<theta>)"
   "vars\<^sub>e\<^sub>s\<^sub>t\<^sub>p ((Step (receive\<langle>t\<rangle>\<^sub>s\<^sub>t)) \<cdot>\<^sub>e\<^sub>s\<^sub>t\<^sub>p \<theta>) = fv (t \<cdot> \<theta>)"
   "vars\<^sub>e\<^sub>s\<^sub>t\<^sub>p ((Step (\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t)) \<cdot>\<^sub>e\<^sub>s\<^sub>t\<^sub>p \<theta>) = fv (t \<cdot> \<theta>) \<union> fv (t' \<cdot> \<theta>)"
   "vars\<^sub>e\<^sub>s\<^sub>t\<^sub>p ((Step (\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t)) \<cdot>\<^sub>e\<^sub>s\<^sub>t\<^sub>p \<theta>) = set X \<union> fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s (F \<cdot>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s rm_vars (set X) \<theta>)"
 by auto
 
 private definition subst_apply_extstrand (infix "\<cdot>\<^sub>e\<^sub>s\<^sub>t" 51) where "S \<cdot>\<^sub>e\<^sub>s\<^sub>t \<theta> \<equiv> map (\<lambda>x. x \<cdot>\<^sub>e\<^sub>s\<^sub>t\<^sub>p \<theta>) S"
 
 private abbreviation update\<^sub>s\<^sub>t::"('fun,'var) strands \<Rightarrow> ('fun,'var) strand \<Rightarrow> ('fun,'var) strands"
 where
   "update\<^sub>s\<^sub>t \<S> S \<equiv> (case S of Nil \<Rightarrow> \<S> - {S} | Cons _ S' \<Rightarrow> insert S' (\<S> - {S}))"
 
 private inductive_set decomps\<^sub>e\<^sub>s\<^sub>t::
   "('fun,'var) terms \<Rightarrow> ('fun,'var) terms \<Rightarrow> ('fun,'var) subst \<Rightarrow> ('fun,'var) extstrands"
 (* \<M>: intruder knowledge
    \<N>: additional messages
 *)
 for \<M> and \<N> and \<I> where
   Nil: "[] \<in> decomps\<^sub>e\<^sub>s\<^sub>t \<M> \<N> \<I>"
 | Decomp: "\<lbrakk>\<D> \<in> decomps\<^sub>e\<^sub>s\<^sub>t \<M> \<N> \<I>; Fun f T \<in> subterms\<^sub>s\<^sub>e\<^sub>t (\<M> \<union> \<N>);
             Ana (Fun f T) = (K,M); M \<noteq> [];
             (\<M> \<union> ik\<^sub>e\<^sub>s\<^sub>t \<D>) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile>\<^sub>c Fun f T \<cdot> \<I>;
             \<And>k. k \<in> set K \<Longrightarrow> (\<M> \<union> ik\<^sub>e\<^sub>s\<^sub>t \<D>) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile>\<^sub>c k \<cdot> \<I>\<rbrakk>
             \<Longrightarrow> \<D>@[Decomp (Fun f T)] \<in> decomps\<^sub>e\<^sub>s\<^sub>t \<M> \<N> \<I>"
 
 private fun decomp_rm\<^sub>e\<^sub>s\<^sub>t::"('fun,'var) extstrand \<Rightarrow> ('fun,'var) extstrand" where
   "decomp_rm\<^sub>e\<^sub>s\<^sub>t [] = []"
 | "decomp_rm\<^sub>e\<^sub>s\<^sub>t (Decomp t#S) = decomp_rm\<^sub>e\<^sub>s\<^sub>t S"
 | "decomp_rm\<^sub>e\<^sub>s\<^sub>t (Step x#S) = Step x#(decomp_rm\<^sub>e\<^sub>s\<^sub>t S)"
 
 private inductive sem\<^sub>e\<^sub>s\<^sub>t_d::"('fun,'var) terms \<Rightarrow> ('fun,'var) subst \<Rightarrow> ('fun,'var) extstrand \<Rightarrow> bool"
 where
   Nil[simp]: "sem\<^sub>e\<^sub>s\<^sub>t_d M\<^sub>0 \<I> []"
 | Send: "sem\<^sub>e\<^sub>s\<^sub>t_d M\<^sub>0 \<I> S \<Longrightarrow> (ik\<^sub>e\<^sub>s\<^sub>t S \<union> M\<^sub>0) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> t \<cdot> \<I> \<Longrightarrow> sem\<^sub>e\<^sub>s\<^sub>t_d M\<^sub>0 \<I> (S@[Step (send\<langle>t\<rangle>\<^sub>s\<^sub>t)])"
 | Receive: "sem\<^sub>e\<^sub>s\<^sub>t_d M\<^sub>0 \<I> S \<Longrightarrow> sem\<^sub>e\<^sub>s\<^sub>t_d M\<^sub>0 \<I> (S@[Step (receive\<langle>t\<rangle>\<^sub>s\<^sub>t)])"
 | Equality: "sem\<^sub>e\<^sub>s\<^sub>t_d M\<^sub>0 \<I> S \<Longrightarrow> t \<cdot> \<I> = t' \<cdot> \<I> \<Longrightarrow> sem\<^sub>e\<^sub>s\<^sub>t_d M\<^sub>0 \<I> (S@[Step (\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t)])"
 | Inequality: "sem\<^sub>e\<^sub>s\<^sub>t_d M\<^sub>0 \<I> S
     \<Longrightarrow> ineq_model \<I> X F
     \<Longrightarrow> sem\<^sub>e\<^sub>s\<^sub>t_d M\<^sub>0 \<I> (S@[Step (\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t)])"
 | Decompose: "sem\<^sub>e\<^sub>s\<^sub>t_d M\<^sub>0 \<I> S \<Longrightarrow> (ik\<^sub>e\<^sub>s\<^sub>t S \<union> M\<^sub>0) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> t \<cdot> \<I> \<Longrightarrow> Ana t = (K, M)
     \<Longrightarrow> (\<And>k. k \<in> set K \<Longrightarrow> (ik\<^sub>e\<^sub>s\<^sub>t S \<union> M\<^sub>0) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> k \<cdot> \<I>) \<Longrightarrow> sem\<^sub>e\<^sub>s\<^sub>t_d M\<^sub>0 \<I> (S@[Decomp t])"
 
 private inductive sem\<^sub>e\<^sub>s\<^sub>t_c::"('fun,'var) terms \<Rightarrow> ('fun,'var) subst \<Rightarrow> ('fun,'var) extstrand \<Rightarrow> bool"
 where
   Nil[simp]: "sem\<^sub>e\<^sub>s\<^sub>t_c M\<^sub>0 \<I> []"
 | Send: "sem\<^sub>e\<^sub>s\<^sub>t_c M\<^sub>0 \<I> S \<Longrightarrow> (ik\<^sub>e\<^sub>s\<^sub>t S \<union> M\<^sub>0) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile>\<^sub>c t \<cdot> \<I> \<Longrightarrow> sem\<^sub>e\<^sub>s\<^sub>t_c M\<^sub>0 \<I> (S@[Step (send\<langle>t\<rangle>\<^sub>s\<^sub>t)])"
 | Receive: "sem\<^sub>e\<^sub>s\<^sub>t_c M\<^sub>0 \<I> S \<Longrightarrow> sem\<^sub>e\<^sub>s\<^sub>t_c M\<^sub>0 \<I> (S@[Step (receive\<langle>t\<rangle>\<^sub>s\<^sub>t)])"
 | Equality: "sem\<^sub>e\<^sub>s\<^sub>t_c M\<^sub>0 \<I> S \<Longrightarrow> t \<cdot> \<I> = t' \<cdot> \<I> \<Longrightarrow> sem\<^sub>e\<^sub>s\<^sub>t_c M\<^sub>0 \<I> (S@[Step (\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t)])"
 | Inequality: "sem\<^sub>e\<^sub>s\<^sub>t_c M\<^sub>0 \<I> S
     \<Longrightarrow> ineq_model \<I> X F
     \<Longrightarrow> sem\<^sub>e\<^sub>s\<^sub>t_c M\<^sub>0 \<I> (S@[Step (\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t)])"
 | Decompose: "sem\<^sub>e\<^sub>s\<^sub>t_c M\<^sub>0 \<I> S \<Longrightarrow> (ik\<^sub>e\<^sub>s\<^sub>t S \<union> M\<^sub>0) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile>\<^sub>c t \<cdot> \<I> \<Longrightarrow> Ana t = (K, M)
     \<Longrightarrow> (\<And>k. k \<in> set K \<Longrightarrow> (ik\<^sub>e\<^sub>s\<^sub>t S \<union> M\<^sub>0) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile>\<^sub>c k \<cdot> \<I>) \<Longrightarrow> sem\<^sub>e\<^sub>s\<^sub>t_c M\<^sub>0 \<I> (S@[Decomp t])"
 
 
 subsubsection \<open>Preliminary Lemmata\<close>
 private lemma wf\<^sub>s\<^sub>t\<^sub>s_wf\<^sub>s\<^sub>t\<^sub>s':
   "wf\<^sub>s\<^sub>t\<^sub>s \<S> = wf\<^sub>s\<^sub>t\<^sub>s' \<S> []"
 by (simp add: wf\<^sub>s\<^sub>t\<^sub>s_def wf\<^sub>s\<^sub>t\<^sub>s'_def)
 
 private lemma decomp_ik:
   assumes "Ana t = (K,M)"
   shows "ik\<^sub>s\<^sub>t (decomp t) = set M"
 using ik_rcv_map[of _ M] ik_rcv_map'[of _ M]
 by (auto simp add: decomp_def inv_def assms)
 
 private lemma decomp_assignment_rhs_empty:
   assumes "Ana t = (K,M)"
   shows "assignment_rhs\<^sub>s\<^sub>t (decomp t) = {}"
 by (auto simp add: decomp_def inv_def assms)
 
 private lemma decomp_tfr\<^sub>s\<^sub>t\<^sub>p:
   "list_all tfr\<^sub>s\<^sub>t\<^sub>p (decomp t)"
 by (auto simp add: decomp_def list_all_def)
 
 private lemma trms\<^sub>e\<^sub>s\<^sub>t_ikI:
   "t \<in> ik\<^sub>e\<^sub>s\<^sub>t A \<Longrightarrow> t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>e\<^sub>s\<^sub>t A)"
 proof (induction A rule: to_st.induct)
   case (2 x S) thus ?case by (cases x) auto
 next
   case (3 t' A)
   obtain K M where Ana: "Ana t' = (K,M)" by (metis surj_pair)
   show ?case using 3 decomp_ik[OF Ana] Ana_subterm[OF Ana] by auto
 qed simp
 
 private lemma trms\<^sub>e\<^sub>s\<^sub>t_ik_assignment_rhsI:
   "t \<in> ik\<^sub>e\<^sub>s\<^sub>t A \<union> assignment_rhs\<^sub>e\<^sub>s\<^sub>t A \<Longrightarrow> t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>e\<^sub>s\<^sub>t A)"
 proof (induction A rule: to_st.induct)
   case (2 x S) thus ?case
   proof (cases x)
     case (Equality ac t t') thus ?thesis using 2 by (cases ac) auto
   qed auto
 next
   case (3 t' A)
   obtain K M where Ana: "Ana t' = (K,M)" by (metis surj_pair)
   show ?case
     using 3 decomp_ik[OF Ana] decomp_assignment_rhs_empty[OF Ana] Ana_subterm[OF Ana]
     by auto
 qed simp
 
 private lemma trms\<^sub>e\<^sub>s\<^sub>t_ik_subtermsI:
   assumes "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t A)"
   shows "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>e\<^sub>s\<^sub>t A)"
 proof -
   obtain t' where "t' \<in> ik\<^sub>e\<^sub>s\<^sub>t A" "t \<sqsubseteq> t'" using trms\<^sub>e\<^sub>s\<^sub>t_ikI assms by auto
   thus ?thesis by (meson contra_subsetD in_subterms_subset_Union trms\<^sub>e\<^sub>s\<^sub>t_ikI)
 qed
 
 private lemma trms\<^sub>e\<^sub>s\<^sub>tD:
   assumes "t \<in> trms\<^sub>e\<^sub>s\<^sub>t A"
   shows "t \<in> trms\<^sub>s\<^sub>t (to_st A)"
 using assms
 proof (induction A)
   case (Cons a A)
   obtain K M where Ana: "Ana t = (K,M)" by (metis surj_pair)
   hence "t \<in> trms\<^sub>s\<^sub>t (decomp t)" unfolding decomp_def by force
   thus ?case using Cons.IH Cons.prems by (cases a) auto
 qed simp
 
 private lemma subst_apply_extstrand_nil[simp]:
   "[] \<cdot>\<^sub>e\<^sub>s\<^sub>t \<theta> = []"
 by (simp add: subst_apply_extstrand_def)
 
 private lemma subst_apply_extstrand_singleton[simp]:
   "[Step (receive\<langle>t\<rangle>\<^sub>s\<^sub>t)] \<cdot>\<^sub>e\<^sub>s\<^sub>t \<theta> = [Step (Receive (t \<cdot> \<theta>))]"
   "[Step (send\<langle>t\<rangle>\<^sub>s\<^sub>t)] \<cdot>\<^sub>e\<^sub>s\<^sub>t \<theta> = [Step (Send (t \<cdot> \<theta>))]"
   "[Step (\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t)] \<cdot>\<^sub>e\<^sub>s\<^sub>t \<theta> = [Step (Equality a (t \<cdot> \<theta>) (t' \<cdot> \<theta>))]"
   "[Decomp t] \<cdot>\<^sub>e\<^sub>s\<^sub>t \<theta> = [Decomp (t \<cdot> \<theta>)]"
 unfolding subst_apply_extstrand_def by auto
 
 private lemma extstrand_subst_hom:
   "(S@S') \<cdot>\<^sub>e\<^sub>s\<^sub>t \<theta> = (S \<cdot>\<^sub>e\<^sub>s\<^sub>t \<theta>)@(S' \<cdot>\<^sub>e\<^sub>s\<^sub>t \<theta>)" "(x#S) \<cdot>\<^sub>e\<^sub>s\<^sub>t \<theta> = (x \<cdot>\<^sub>e\<^sub>s\<^sub>t\<^sub>p \<theta>)#(S \<cdot>\<^sub>e\<^sub>s\<^sub>t \<theta>)"
 unfolding subst_apply_extstrand_def by auto
 
 private lemma decomp_vars:
   "wfrestrictedvars\<^sub>s\<^sub>t (decomp t) = fv t" "vars\<^sub>s\<^sub>t (decomp t) = fv t" "bvars\<^sub>s\<^sub>t (decomp t) = {}"
   "fv\<^sub>s\<^sub>t (decomp t) = fv t"
 proof -
   obtain K M where Ana: "Ana t = (K,M)" by (metis surj_pair)
   hence "decomp t = send\<langle>t\<rangle>\<^sub>s\<^sub>t#map Send K@map Receive M"
     unfolding decomp_def by simp
   moreover have "\<Union>(set (map fv K)) = fv\<^sub>s\<^sub>e\<^sub>t (set K)" "\<Union>(set (map fv M)) = fv\<^sub>s\<^sub>e\<^sub>t (set M)" by auto
   moreover have "fv\<^sub>s\<^sub>e\<^sub>t (set K) \<subseteq> fv t" "fv\<^sub>s\<^sub>e\<^sub>t (set M) \<subseteq> fv t"
     using Ana_subterm[OF Ana(1)] Ana_keys_fv[OF Ana(1)]
     by (simp_all add: UN_least psubsetD subtermeq_vars_subset)
   ultimately show
       "wfrestrictedvars\<^sub>s\<^sub>t (decomp t) = fv t" "vars\<^sub>s\<^sub>t (decomp t) = fv t" "bvars\<^sub>s\<^sub>t (decomp t) = {}"
       "fv\<^sub>s\<^sub>t (decomp t) = fv t"
     by auto
 qed
 
 private lemma bvars\<^sub>e\<^sub>s\<^sub>t_cons: "bvars\<^sub>e\<^sub>s\<^sub>t (x#X) = bvars\<^sub>e\<^sub>s\<^sub>t [x] \<union> bvars\<^sub>e\<^sub>s\<^sub>t X"
 by (cases x) auto
 
 private lemma bvars\<^sub>e\<^sub>s\<^sub>t_append: "bvars\<^sub>e\<^sub>s\<^sub>t (A@B) = bvars\<^sub>e\<^sub>s\<^sub>t A \<union> bvars\<^sub>e\<^sub>s\<^sub>t B"
 proof (induction A)
   case (Cons x A) thus ?case using bvars\<^sub>e\<^sub>s\<^sub>t_cons[of x "A@B"] bvars\<^sub>e\<^sub>s\<^sub>t_cons[of x A] by force
 qed simp
 
 private lemma fv\<^sub>e\<^sub>s\<^sub>t_cons: "fv\<^sub>e\<^sub>s\<^sub>t (x#X) = fv\<^sub>e\<^sub>s\<^sub>t [x] \<union> fv\<^sub>e\<^sub>s\<^sub>t X"
 by (cases x) auto
 
 private lemma fv\<^sub>e\<^sub>s\<^sub>t_append: "fv\<^sub>e\<^sub>s\<^sub>t (A@B) = fv\<^sub>e\<^sub>s\<^sub>t A \<union> fv\<^sub>e\<^sub>s\<^sub>t B"
 proof (induction A)
   case (Cons x A) thus ?case using fv\<^sub>e\<^sub>s\<^sub>t_cons[of x "A@B"] fv\<^sub>e\<^sub>s\<^sub>t_cons[of x A] by auto
 qed simp
 
 private lemma bvars_decomp: "bvars\<^sub>e\<^sub>s\<^sub>t (A@[Decomp t]) = bvars\<^sub>e\<^sub>s\<^sub>t A" "bvars\<^sub>e\<^sub>s\<^sub>t (Decomp t#A) = bvars\<^sub>e\<^sub>s\<^sub>t A"
 using bvars\<^sub>e\<^sub>s\<^sub>t_append decomp_vars(3) by fastforce+
 
 private lemma bvars_decomp_rm: "bvars\<^sub>e\<^sub>s\<^sub>t (decomp_rm\<^sub>e\<^sub>s\<^sub>t A) = bvars\<^sub>e\<^sub>s\<^sub>t A"
 using bvars_decomp by (induct A rule: decomp_rm\<^sub>e\<^sub>s\<^sub>t.induct) simp_all+
 
 private lemma fv_decomp_rm: "fv\<^sub>e\<^sub>s\<^sub>t (decomp_rm\<^sub>e\<^sub>s\<^sub>t A) \<subseteq> fv\<^sub>e\<^sub>s\<^sub>t A"
 by (induct A rule: decomp_rm\<^sub>e\<^sub>s\<^sub>t.induct) auto
 
 private lemma ik_assignment_rhs_decomp_fv:
   assumes "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t A \<union> assignment_rhs\<^sub>e\<^sub>s\<^sub>t A)"
   shows "fv\<^sub>e\<^sub>s\<^sub>t (A@[Decomp t]) = fv\<^sub>e\<^sub>s\<^sub>t A"
 proof -
   have "fv\<^sub>e\<^sub>s\<^sub>t (A@[Decomp t]) = fv\<^sub>e\<^sub>s\<^sub>t A \<union> fv t" using fv\<^sub>e\<^sub>s\<^sub>t_append decomp_vars by simp
   moreover have "fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t A \<union> assignment_rhs\<^sub>e\<^sub>s\<^sub>t A) \<subseteq> fv\<^sub>e\<^sub>s\<^sub>t A" by force
   moreover have "fv t \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t A \<union> assignment_rhs\<^sub>e\<^sub>s\<^sub>t A)"
     using fv_subset_subterms[OF assms(1)] by simp
   ultimately show ?thesis by blast
 qed
 
 private lemma wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t_decomp_rm\<^sub>e\<^sub>s\<^sub>t_subset:
   "wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t (decomp_rm\<^sub>e\<^sub>s\<^sub>t A) \<subseteq> wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t A"
 by (induct A rule: decomp_rm\<^sub>e\<^sub>s\<^sub>t.induct) auto+
 
 private lemma wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t_eq_wfrestrictedvars\<^sub>s\<^sub>t:
   "wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t A = wfrestrictedvars\<^sub>s\<^sub>t (to_st A)"
 by simp
 
 private lemma decomp_set_unfold:
   assumes "Ana t = (K, M)"
   shows "set (decomp t) = {send\<langle>t\<rangle>\<^sub>s\<^sub>t} \<union> (Send ` set K) \<union> (Receive ` set M)"
 using assms unfolding decomp_def by auto
 
 private lemma ik\<^sub>e\<^sub>s\<^sub>t_finite: "finite (ik\<^sub>e\<^sub>s\<^sub>t A)"
 by (rule finite_ik\<^sub>s\<^sub>t)
 
 private lemma assignment_rhs\<^sub>e\<^sub>s\<^sub>t_finite: "finite (assignment_rhs\<^sub>e\<^sub>s\<^sub>t A)"
 by (rule finite_assignment_rhs\<^sub>s\<^sub>t)
 
 private lemma to_est_append: "to_est (A@B) = to_est A@to_est B"
 by (induct A rule: to_est.induct) auto
 
 private lemma to_st_to_est_inv: "to_st (to_est A) = A"
 by (induct A rule: to_est.induct) auto
 
 private lemma to_st_append: "to_st (A@B) = (to_st A)@(to_st B)"
 by (induct A rule: to_st.induct) auto
 
 private lemma to_st_cons: "to_st (a#B) = (to_st [a])@(to_st B)"
 using to_st_append[of "[a]" B] by simp
 
 private lemma wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t_split:
   "wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t (x#S) = wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t [x] \<union> wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t S"
   "wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t (S@S') = wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t S \<union> wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t S'"
 using to_st_cons[of x S] to_st_append[of S S'] by auto
 
 private lemma ik\<^sub>e\<^sub>s\<^sub>t_append: "ik\<^sub>e\<^sub>s\<^sub>t (A@B) = ik\<^sub>e\<^sub>s\<^sub>t A \<union> ik\<^sub>e\<^sub>s\<^sub>t B"
 by (metis ik_append to_st_append)
 
 private lemma assignment_rhs\<^sub>e\<^sub>s\<^sub>t_append:
   "assignment_rhs\<^sub>e\<^sub>s\<^sub>t (A@B) = assignment_rhs\<^sub>e\<^sub>s\<^sub>t A \<union> assignment_rhs\<^sub>e\<^sub>s\<^sub>t B"
 by (metis assignment_rhs_append to_st_append)
 
 private lemma ik\<^sub>e\<^sub>s\<^sub>t_cons: "ik\<^sub>e\<^sub>s\<^sub>t (a#A) = ik\<^sub>e\<^sub>s\<^sub>t [a] \<union> ik\<^sub>e\<^sub>s\<^sub>t A"
-by (metis ik_append to_st_cons) 
+by (metis ik_append to_st_cons)
 
 private lemma ik\<^sub>e\<^sub>s\<^sub>t_append_subst:
   "ik\<^sub>e\<^sub>s\<^sub>t (A@B \<cdot>\<^sub>e\<^sub>s\<^sub>t \<theta>) = ik\<^sub>e\<^sub>s\<^sub>t (A \<cdot>\<^sub>e\<^sub>s\<^sub>t \<theta>) \<union> ik\<^sub>e\<^sub>s\<^sub>t (B \<cdot>\<^sub>e\<^sub>s\<^sub>t \<theta>)"
   "ik\<^sub>e\<^sub>s\<^sub>t (A@B) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta> = (ik\<^sub>e\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>) \<union> (ik\<^sub>e\<^sub>s\<^sub>t B \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>)"
 by (metis ik\<^sub>e\<^sub>s\<^sub>t_append extstrand_subst_hom(1), simp add: image_Un to_st_append)
 
 private lemma assignment_rhs\<^sub>e\<^sub>s\<^sub>t_append_subst:
   "assignment_rhs\<^sub>e\<^sub>s\<^sub>t (A@B \<cdot>\<^sub>e\<^sub>s\<^sub>t \<theta>) = assignment_rhs\<^sub>e\<^sub>s\<^sub>t (A \<cdot>\<^sub>e\<^sub>s\<^sub>t \<theta>) \<union> assignment_rhs\<^sub>e\<^sub>s\<^sub>t (B \<cdot>\<^sub>e\<^sub>s\<^sub>t \<theta>)"
   "assignment_rhs\<^sub>e\<^sub>s\<^sub>t (A@B) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta> = (assignment_rhs\<^sub>e\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>) \<union> (assignment_rhs\<^sub>e\<^sub>s\<^sub>t B \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>)"
 by (metis assignment_rhs\<^sub>e\<^sub>s\<^sub>t_append extstrand_subst_hom(1), use assignment_rhs\<^sub>e\<^sub>s\<^sub>t_append in blast)
 
 private lemma ik\<^sub>e\<^sub>s\<^sub>t_cons_subst:
   "ik\<^sub>e\<^sub>s\<^sub>t (a#A \<cdot>\<^sub>e\<^sub>s\<^sub>t \<theta>) = ik\<^sub>e\<^sub>s\<^sub>t ([a \<cdot>\<^sub>e\<^sub>s\<^sub>t\<^sub>p \<theta>]) \<union> ik\<^sub>e\<^sub>s\<^sub>t (A \<cdot>\<^sub>e\<^sub>s\<^sub>t \<theta>)"
   "ik\<^sub>e\<^sub>s\<^sub>t (a#A) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta> = (ik\<^sub>e\<^sub>s\<^sub>t [a] \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>) \<union> (ik\<^sub>e\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<theta>)"
 by (metis ik\<^sub>e\<^sub>s\<^sub>t_cons extstrand_subst_hom(2), metis image_Un ik\<^sub>e\<^sub>s\<^sub>t_cons)
 
 private lemma decomp_rm\<^sub>e\<^sub>s\<^sub>t_append: "decomp_rm\<^sub>e\<^sub>s\<^sub>t (S@S') = (decomp_rm\<^sub>e\<^sub>s\<^sub>t S)@(decomp_rm\<^sub>e\<^sub>s\<^sub>t S')"
 by (induct S rule: decomp_rm\<^sub>e\<^sub>s\<^sub>t.induct) auto
 
 private lemma decomp_rm\<^sub>e\<^sub>s\<^sub>t_single[simp]:
   "decomp_rm\<^sub>e\<^sub>s\<^sub>t [Step (send\<langle>t\<rangle>\<^sub>s\<^sub>t)] = [Step (send\<langle>t\<rangle>\<^sub>s\<^sub>t)]"
   "decomp_rm\<^sub>e\<^sub>s\<^sub>t [Step (receive\<langle>t\<rangle>\<^sub>s\<^sub>t)] = [Step (receive\<langle>t\<rangle>\<^sub>s\<^sub>t)]"
   "decomp_rm\<^sub>e\<^sub>s\<^sub>t [Decomp t] = []"
 by auto
 
 private lemma decomp_rm\<^sub>e\<^sub>s\<^sub>t_ik_subset: "ik\<^sub>e\<^sub>s\<^sub>t (decomp_rm\<^sub>e\<^sub>s\<^sub>t S) \<subseteq> ik\<^sub>e\<^sub>s\<^sub>t S"
 proof (induction S rule: decomp_rm\<^sub>e\<^sub>s\<^sub>t.induct)
   case (3 x S) thus ?case by (cases x) auto
 qed auto
 
 private lemma decomps\<^sub>e\<^sub>s\<^sub>t_ik_subset: "D \<in> decomps\<^sub>e\<^sub>s\<^sub>t M N \<I> \<Longrightarrow> ik\<^sub>e\<^sub>s\<^sub>t D \<subseteq> subterms\<^sub>s\<^sub>e\<^sub>t (M \<union> N)"
 proof (induction D rule: decomps\<^sub>e\<^sub>s\<^sub>t.induct)
   case (Decomp D f T K M')
   have "ik\<^sub>s\<^sub>t (decomp (Fun f T)) \<subseteq> subterms (Fun f T)"
        "ik\<^sub>s\<^sub>t (decomp (Fun f T)) = ik\<^sub>e\<^sub>s\<^sub>t [Decomp (Fun f T)]"
     using decomp_ik[OF Decomp.hyps(3)] Ana_subterm[OF Decomp.hyps(3)]
     by auto
   hence "ik\<^sub>s\<^sub>t (to_st [Decomp (Fun f T)]) \<subseteq> subterms\<^sub>s\<^sub>e\<^sub>t (M \<union> N)"
     using in_subterms_subset_Union[OF Decomp.hyps(2)]
     by blast
   thus ?case using ik\<^sub>e\<^sub>s\<^sub>t_append[of D "[Decomp (Fun f T)]"] using Decomp.IH by auto
 qed simp
 
 private lemma decomps\<^sub>e\<^sub>s\<^sub>t_decomp_rm\<^sub>e\<^sub>s\<^sub>t_empty: "D \<in> decomps\<^sub>e\<^sub>s\<^sub>t M N \<I> \<Longrightarrow> decomp_rm\<^sub>e\<^sub>s\<^sub>t D = []"
 by (induct D rule: decomps\<^sub>e\<^sub>s\<^sub>t.induct) (auto simp add: decomp_rm\<^sub>e\<^sub>s\<^sub>t_append)
 
 private lemma decomps\<^sub>e\<^sub>s\<^sub>t_append:
   assumes "A \<in> decomps\<^sub>e\<^sub>s\<^sub>t S N \<I>" "B \<in> decomps\<^sub>e\<^sub>s\<^sub>t S N \<I>"
   shows "A@B \<in> decomps\<^sub>e\<^sub>s\<^sub>t S N \<I>"
 using assms(2)
 proof (induction B rule: decomps\<^sub>e\<^sub>s\<^sub>t.induct)
   case Nil show ?case using assms(1) by simp
 next
   case (Decomp B f X K T)
   hence "S \<union> ik\<^sub>e\<^sub>s\<^sub>t B \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<subseteq> S \<union> ik\<^sub>e\<^sub>s\<^sub>t (A@B) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" using ik\<^sub>e\<^sub>s\<^sub>t_append by auto
   thus ?case
     using decomps\<^sub>e\<^sub>s\<^sub>t.Decomp[OF Decomp.IH(1) Decomp.hyps(2,3,4)]
           ideduct_synth_mono[OF Decomp.hyps(5)]
           ideduct_synth_mono[OF Decomp.hyps(6)]
     by auto
 qed
 
 private lemma decomps\<^sub>e\<^sub>s\<^sub>t_subterms:
   assumes "A' \<in> decomps\<^sub>e\<^sub>s\<^sub>t M N \<I>"
   shows "subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t A') \<subseteq> subterms\<^sub>s\<^sub>e\<^sub>t (M \<union> N)"
 using assms
 proof (induction A' rule: decomps\<^sub>e\<^sub>s\<^sub>t.induct)
   case (Decomp D f X K T)
   hence "Fun f X \<in> subterms\<^sub>s\<^sub>e\<^sub>t (M \<union> N)" by auto
   hence "subterms\<^sub>s\<^sub>e\<^sub>t (set X) \<subseteq> subterms\<^sub>s\<^sub>e\<^sub>t (M \<union> N)"
     using in_subterms_subset_Union[of "Fun f X" "M \<union> N"] params_subterms_Union[of X f]
     by blast
   moreover have "ik\<^sub>s\<^sub>t (to_st [Decomp (Fun f X)]) = set T" using Decomp.hyps(3) decomp_ik by simp
   hence "subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>s\<^sub>t (to_st [Decomp (Fun f X)])) \<subseteq> subterms\<^sub>s\<^sub>e\<^sub>t (set X)"
     using Ana_fun_subterm[OF Decomp.hyps(3)] by auto
   ultimately show ?case
     using ik\<^sub>e\<^sub>s\<^sub>t_append[of D "[Decomp (Fun f X)]"] Decomp.IH
     by auto
 qed simp
 
 private lemma decomps\<^sub>e\<^sub>s\<^sub>t_assignment_rhs_empty:
   assumes "A' \<in> decomps\<^sub>e\<^sub>s\<^sub>t M N \<I>"
   shows "assignment_rhs\<^sub>e\<^sub>s\<^sub>t A' = {}"
 using assms
 by (induction A' rule: decomps\<^sub>e\<^sub>s\<^sub>t.induct)
-   (simp_all add: decomp_assignment_rhs_empty assignment_rhs\<^sub>e\<^sub>s\<^sub>t_append) 
+   (simp_all add: decomp_assignment_rhs_empty assignment_rhs\<^sub>e\<^sub>s\<^sub>t_append)
 
 private lemma decomps\<^sub>e\<^sub>s\<^sub>t_finite_ik_append:
   assumes "finite M" "M \<subseteq> decomps\<^sub>e\<^sub>s\<^sub>t A N \<I>"
   shows "\<exists>D \<in> decomps\<^sub>e\<^sub>s\<^sub>t A N \<I>. ik\<^sub>e\<^sub>s\<^sub>t D = (\<Union>m \<in> M. ik\<^sub>e\<^sub>s\<^sub>t m)"
 using assms
 proof (induction M rule: finite_induct)
   case empty
   moreover have "[] \<in> decomps\<^sub>e\<^sub>s\<^sub>t A N \<I>" "ik\<^sub>s\<^sub>t (to_st []) = {}" using decomps\<^sub>e\<^sub>s\<^sub>t.Nil by auto
   ultimately show ?case by blast
 next
   case (insert m M)
   then obtain D where "D \<in> decomps\<^sub>e\<^sub>s\<^sub>t A N \<I>" "ik\<^sub>e\<^sub>s\<^sub>t D = (\<Union>m\<in>M. ik\<^sub>s\<^sub>t (to_st m))" by moura
   moreover have "m \<in> decomps\<^sub>e\<^sub>s\<^sub>t A N \<I>" using insert.prems(1) by blast
   ultimately show ?case using decomps\<^sub>e\<^sub>s\<^sub>t_append[of D A N \<I> m] ik\<^sub>e\<^sub>s\<^sub>t_append[of D m] by blast
 qed
 
 private lemma decomp_snd_exists[simp]: "\<exists>D. decomp t = send\<langle>t\<rangle>\<^sub>s\<^sub>t#D"
 by (metis (mono_tags, lifting) decomp_def prod.case surj_pair)
 
 private lemma decomp_nonnil[simp]: "decomp t \<noteq> []"
 using decomp_snd_exists[of t] by fastforce
 
 private lemma to_st_nil_inv[dest]: "to_st A = [] \<Longrightarrow> A = []"
 by (induct A rule: to_st.induct) auto
 
 private lemma well_analyzedD:
   assumes "well_analyzed A" "Decomp t \<in> set A"
   shows "\<exists>f T. t = Fun f T"
 using assms
 proof (induction A rule: well_analyzed.induct)
   case (Decomp A t')
   hence "\<exists>f T. t' = Fun f T" by (cases t') auto
   moreover have "Decomp t \<in> set A \<or> t = t'" using Decomp by auto
   ultimately show ?case using Decomp.IH by auto
 qed auto
 
 private lemma well_analyzed_inv:
   assumes "well_analyzed (A@[Decomp t])"
   shows "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t A \<union> assignment_rhs\<^sub>e\<^sub>s\<^sub>t A) - (Var ` \<V>)"
 using assms well_analyzed.cases[of "A@[Decomp t]"] by fastforce
 
 private lemma well_analyzed_split_left_single: "well_analyzed (A@[a]) \<Longrightarrow> well_analyzed A"
 by (induction "A@[a]" rule: well_analyzed.induct) auto
 
 private lemma well_analyzed_split_left: "well_analyzed (A@B) \<Longrightarrow> well_analyzed A"
 proof (induction B rule: List.rev_induct)
   case (snoc b B) thus ?case using well_analyzed_split_left_single[of "A@B" b] by simp
 qed simp
 
 private lemma well_analyzed_append:
   assumes "well_analyzed A" "well_analyzed B"
   shows "well_analyzed (A@B)"
 using assms(2,1)
 proof (induction B rule: well_analyzed.induct)
   case (Step B x) show ?case using well_analyzed.Step[OF Step.IH[OF Step.prems]] by simp
 next
   case (Decomp B t) thus ?case
     using well_analyzed.Decomp[OF Decomp.IH[OF Decomp.prems]] ik\<^sub>e\<^sub>s\<^sub>t_append assignment_rhs\<^sub>e\<^sub>s\<^sub>t_append
     by auto
 qed simp_all
 
 private lemma well_analyzed_singleton:
   "well_analyzed [Step (send\<langle>t\<rangle>\<^sub>s\<^sub>t)]" "well_analyzed [Step (receive\<langle>t\<rangle>\<^sub>s\<^sub>t)]"
   "well_analyzed [Step (\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t)]" "well_analyzed [Step (\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t)]"
   "\<not>well_analyzed [Decomp t]"
 proof -
   show "well_analyzed [Step (send\<langle>t\<rangle>\<^sub>s\<^sub>t)]" "well_analyzed [Step (receive\<langle>t\<rangle>\<^sub>s\<^sub>t)]"
        "well_analyzed [Step (\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t)]" "well_analyzed [Step (\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t)]"
     using well_analyzed.Step[OF well_analyzed.Nil]
     by simp_all
 
   show "\<not>well_analyzed [Decomp t]" using well_analyzed.cases[of "[Decomp t]"] by auto
 qed
 
 private lemma well_analyzed_decomp_rm\<^sub>e\<^sub>s\<^sub>t_fv: "well_analyzed A \<Longrightarrow> fv\<^sub>e\<^sub>s\<^sub>t (decomp_rm\<^sub>e\<^sub>s\<^sub>t A) = fv\<^sub>e\<^sub>s\<^sub>t A"
 proof
   assume "well_analyzed A" thus "fv\<^sub>e\<^sub>s\<^sub>t A \<subseteq> fv\<^sub>e\<^sub>s\<^sub>t (decomp_rm\<^sub>e\<^sub>s\<^sub>t A)"
   proof (induction A rule: well_analyzed.induct)
     case Decomp thus ?case using ik_assignment_rhs_decomp_fv decomp_rm\<^sub>e\<^sub>s\<^sub>t_append by auto
   next
     case (Step A x)
     have "fv\<^sub>e\<^sub>s\<^sub>t (A@[Step x]) = fv\<^sub>e\<^sub>s\<^sub>t A \<union> fv\<^sub>s\<^sub>t\<^sub>p x"
          "fv\<^sub>e\<^sub>s\<^sub>t (decomp_rm\<^sub>e\<^sub>s\<^sub>t (A@[Step x])) = fv\<^sub>e\<^sub>s\<^sub>t (decomp_rm\<^sub>e\<^sub>s\<^sub>t A) \<union> fv\<^sub>s\<^sub>t\<^sub>p x"
       using fv\<^sub>e\<^sub>s\<^sub>t_append decomp_rm\<^sub>e\<^sub>s\<^sub>t_append by auto
     thus ?case using Step by auto
   qed simp
 qed (rule fv_decomp_rm)
 
 private lemma sem\<^sub>e\<^sub>s\<^sub>t_d_split_left: assumes "sem\<^sub>e\<^sub>s\<^sub>t_d M\<^sub>0 \<I> (\<A>@\<A>')" shows "sem\<^sub>e\<^sub>s\<^sub>t_d M\<^sub>0 \<I> \<A>"
 using assms sem\<^sub>e\<^sub>s\<^sub>t_d.cases by (induction \<A>' rule: List.rev_induct) fastforce+
 
 private lemma sem\<^sub>e\<^sub>s\<^sub>t_d_eq_sem_st: "sem\<^sub>e\<^sub>s\<^sub>t_d M\<^sub>0 \<I> \<A> = \<lbrakk>M\<^sub>0; to_st \<A>\<rbrakk>\<^sub>d' \<I>"
 proof
   show "\<lbrakk>M\<^sub>0; to_st \<A>\<rbrakk>\<^sub>d' \<I> \<Longrightarrow> sem\<^sub>e\<^sub>s\<^sub>t_d M\<^sub>0 \<I> \<A>"
   proof (induction \<A> arbitrary: M\<^sub>0 rule: List.rev_induct)
     case Nil show ?case using to_st_nil_inv by simp
   next
     case (snoc a \<A>)
     hence IH: "sem\<^sub>e\<^sub>s\<^sub>t_d M\<^sub>0 \<I> \<A>" and *: "\<lbrakk>ik\<^sub>e\<^sub>s\<^sub>t \<A> \<union> M\<^sub>0; to_st [a]\<rbrakk>\<^sub>d' \<I>"
       using to_st_append by (auto simp add: sup.commute)
     thus ?case using snoc
     proof (cases a)
       case (Step b) thus ?thesis
       proof (cases b)
         case (Send t) thus ?thesis using sem\<^sub>e\<^sub>s\<^sub>t_d.Send[OF IH] * Step by auto
       next
         case (Receive t) thus ?thesis using sem\<^sub>e\<^sub>s\<^sub>t_d.Receive[OF IH] Step by auto
       next
         case (Equality a t t') thus ?thesis using sem\<^sub>e\<^sub>s\<^sub>t_d.Equality[OF IH] * Step by auto
       next
         case (Inequality X F) thus ?thesis using sem\<^sub>e\<^sub>s\<^sub>t_d.Inequality[OF IH] * Step by auto
       qed
     next
       case (Decomp t)
       obtain K M where Ana: "Ana t = (K,M)" by moura
       have "to_st [a] = decomp t" using Decomp by auto
       hence "to_st [a] = send\<langle>t\<rangle>\<^sub>s\<^sub>t#map Send K@map Receive M"
         using Ana unfolding decomp_def by auto
       hence **: "ik\<^sub>e\<^sub>s\<^sub>t \<A> \<union> M\<^sub>0 \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> t \<cdot> \<I>" and "\<lbrakk>ik\<^sub>e\<^sub>s\<^sub>t \<A> \<union> M\<^sub>0; map Send K\<rbrakk>\<^sub>d' \<I>"
         using * by auto
       hence "\<And>k. k \<in> set K \<Longrightarrow> ik\<^sub>e\<^sub>s\<^sub>t \<A> \<union> M\<^sub>0 \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> k \<cdot> \<I>"
         using *
         by (metis (full_types) strand_sem_d.simps(2) strand_sem_eq_defs(2) strand_sem_Send_split(2))
       thus ?thesis using Decomp sem\<^sub>e\<^sub>s\<^sub>t_d.Decompose[OF IH ** Ana] by metis
     qed
   qed
 
   show "sem\<^sub>e\<^sub>s\<^sub>t_d M\<^sub>0 \<I> \<A> \<Longrightarrow> \<lbrakk>M\<^sub>0; to_st \<A>\<rbrakk>\<^sub>d' \<I>"
   proof (induction rule: sem\<^sub>e\<^sub>s\<^sub>t_d.induct)
     case Nil thus ?case by simp
   next
     case (Send M\<^sub>0 \<I> \<A> t) thus ?case
       using strand_sem_append'[of M\<^sub>0 "to_st \<A>" \<I> "[send\<langle>t\<rangle>\<^sub>s\<^sub>t]"]
             to_st_append[of \<A> "[Step (send\<langle>t\<rangle>\<^sub>s\<^sub>t)]"]
       by (simp add: sup.commute)
   next
     case (Receive M\<^sub>0 \<I> \<A> t) thus ?case
       using strand_sem_append'[of M\<^sub>0 "to_st \<A>" \<I> "[receive\<langle>t\<rangle>\<^sub>s\<^sub>t]"]
             to_st_append[of \<A> "[Step (receive\<langle>t\<rangle>\<^sub>s\<^sub>t)]"]
       by (simp add: sup.commute)
   next
     case (Equality M\<^sub>0 \<I> \<A> t t' a) thus ?case
       using strand_sem_append'[of M\<^sub>0 "to_st \<A>" \<I> "[\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t]"]
             to_st_append[of \<A> "[Step (\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t)]"]
       by (simp add: sup.commute)
   next
     case (Inequality M\<^sub>0 \<I> \<A> X F) thus ?case
       using strand_sem_append'[of M\<^sub>0 "to_st \<A>" \<I> "[\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t]"]
             to_st_append[of \<A> "[Step (\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t)]"]
       by (simp add: sup.commute)
   next
     case (Decompose M\<^sub>0 \<I> \<A> t K M)
     have "\<lbrakk>M\<^sub>0 \<union> ik\<^sub>s\<^sub>t (to_st \<A>); decomp t\<rbrakk>\<^sub>d' \<I>"
     proof -
       have "\<lbrakk>M\<^sub>0 \<union> ik\<^sub>s\<^sub>t (to_st \<A>); [send\<langle>t\<rangle>\<^sub>s\<^sub>t]\<rbrakk>\<^sub>d' \<I>"
         using Decompose.hyps(2) by (auto simp add: sup.commute)
       moreover have "\<And>k. k \<in> set K \<Longrightarrow> M\<^sub>0 \<union> ik\<^sub>s\<^sub>t (to_st \<A>) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> k \<cdot> \<I>"
         using Decompose by (metis sup.commute)
       hence "\<And>k. k \<in> set K \<Longrightarrow> \<lbrakk>M\<^sub>0 \<union> ik\<^sub>s\<^sub>t (to_st \<A>); [Send k]\<rbrakk>\<^sub>d' \<I>" by auto
       hence "\<lbrakk>M\<^sub>0 \<union> ik\<^sub>s\<^sub>t (to_st \<A>); map Send K\<rbrakk>\<^sub>d' \<I>"
         using strand_sem_Send_map(2)[of K, of "M\<^sub>0 \<union> ik\<^sub>s\<^sub>t (to_st \<A>) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" \<I>] strand_sem_eq_defs(2)
         by auto
       moreover have "\<lbrakk>M\<^sub>0 \<union> ik\<^sub>s\<^sub>t (to_st \<A>); map Receive M\<rbrakk>\<^sub>d' \<I>"
         by (metis strand_sem_Receive_map(2) strand_sem_eq_defs(2))
       ultimately have
           "\<lbrakk>M\<^sub>0 \<union> ik\<^sub>s\<^sub>t (to_st \<A>); send\<langle>t\<rangle>\<^sub>s\<^sub>t#map Send K@map Receive M\<rbrakk>\<^sub>d' \<I>"
         by auto
       thus ?thesis using Decompose.hyps(3) unfolding decomp_def by auto
     qed
     hence "\<lbrakk>M\<^sub>0; to_st \<A>@decomp t\<rbrakk>\<^sub>d' \<I>"
       using strand_sem_append'[of M\<^sub>0 "to_st \<A>" \<I> "decomp t"] Decompose.IH
       by simp
     thus ?case using to_st_append[of \<A> "[Decomp t]"] by simp
   qed
 qed
 
 private lemma sem\<^sub>e\<^sub>s\<^sub>t_c_eq_sem_st: "sem\<^sub>e\<^sub>s\<^sub>t_c M\<^sub>0 \<I> \<A> = \<lbrakk>M\<^sub>0; to_st \<A>\<rbrakk>\<^sub>c' \<I>"
 proof
   show "\<lbrakk>M\<^sub>0; to_st \<A>\<rbrakk>\<^sub>c' \<I> \<Longrightarrow> sem\<^sub>e\<^sub>s\<^sub>t_c M\<^sub>0 \<I> \<A>"
   proof (induction \<A> arbitrary: M\<^sub>0 rule: List.rev_induct)
     case Nil show ?case using to_st_nil_inv by simp
   next
     case (snoc a \<A>)
     hence IH: "sem\<^sub>e\<^sub>s\<^sub>t_c M\<^sub>0 \<I> \<A>" and *: "\<lbrakk>ik\<^sub>e\<^sub>s\<^sub>t \<A> \<union> M\<^sub>0; to_st [a]\<rbrakk>\<^sub>c' \<I>"
       using to_st_append
       by (auto simp add: sup.commute)
     thus ?case using snoc
     proof (cases a)
       case (Step b) thus ?thesis
       proof (cases b)
         case (Send t) thus ?thesis using sem\<^sub>e\<^sub>s\<^sub>t_c.Send[OF IH] * Step by auto
       next
         case (Receive t) thus ?thesis using sem\<^sub>e\<^sub>s\<^sub>t_c.Receive[OF IH] Step by auto
       next
         case (Equality t) thus ?thesis using sem\<^sub>e\<^sub>s\<^sub>t_c.Equality[OF IH] * Step by auto
       next
         case (Inequality t) thus ?thesis using sem\<^sub>e\<^sub>s\<^sub>t_c.Inequality[OF IH] * Step by auto
       qed
     next
       case (Decomp t)
       obtain K M where Ana: "Ana t = (K,M)" by moura
       have "to_st [a] = decomp t" using Decomp by auto
       hence "to_st [a] = send\<langle>t\<rangle>\<^sub>s\<^sub>t#map Send K@map Receive M"
         using Ana unfolding decomp_def by auto
       hence **: "ik\<^sub>e\<^sub>s\<^sub>t \<A> \<union> M\<^sub>0 \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile>\<^sub>c t \<cdot> \<I>" and "\<lbrakk>ik\<^sub>e\<^sub>s\<^sub>t \<A> \<union> M\<^sub>0; map Send K\<rbrakk>\<^sub>c' \<I>"
         using * by auto
       hence "\<And>k. k \<in> set K \<Longrightarrow> ik\<^sub>e\<^sub>s\<^sub>t \<A> \<union> M\<^sub>0 \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile>\<^sub>c k \<cdot> \<I>"
         using * strand_sem_Send_split(1) strand_sem_eq_defs(1)
         by auto
       thus ?thesis using Decomp sem\<^sub>e\<^sub>s\<^sub>t_c.Decompose[OF IH ** Ana] by metis
     qed
   qed
 
   show "sem\<^sub>e\<^sub>s\<^sub>t_c M\<^sub>0 \<I> \<A> \<Longrightarrow> \<lbrakk>M\<^sub>0; to_st \<A>\<rbrakk>\<^sub>c' \<I>"
   proof (induction rule: sem\<^sub>e\<^sub>s\<^sub>t_c.induct)
     case Nil thus ?case by simp
   next
     case (Send M\<^sub>0 \<I> \<A> t) thus ?case
       using strand_sem_append'[of M\<^sub>0 "to_st \<A>" \<I> "[send\<langle>t\<rangle>\<^sub>s\<^sub>t]"]
             to_st_append[of \<A> "[Step (send\<langle>t\<rangle>\<^sub>s\<^sub>t)]"]
       by (simp add: sup.commute)
   next
     case (Receive M\<^sub>0 \<I> \<A> t) thus ?case
       using strand_sem_append'[of M\<^sub>0 "to_st \<A>" \<I> "[receive\<langle>t\<rangle>\<^sub>s\<^sub>t]"]
             to_st_append[of \<A> "[Step (receive\<langle>t\<rangle>\<^sub>s\<^sub>t)]"]
       by (simp add: sup.commute)
   next
     case (Equality M\<^sub>0 \<I> \<A> t t' a) thus ?case
       using strand_sem_append'[of M\<^sub>0 "to_st \<A>" \<I> "[\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t]"]
             to_st_append[of \<A> "[Step (\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t)]"]
       by (simp add: sup.commute)
   next
     case (Inequality M\<^sub>0 \<I> \<A> X F) thus ?case
       using strand_sem_append'[of M\<^sub>0 "to_st \<A>" \<I> "[\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t]"]
             to_st_append[of \<A> "[Step (\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t)]"]
       by (auto simp add: sup.commute)
   next
     case (Decompose M\<^sub>0 \<I> \<A> t K M)
     have "\<lbrakk>M\<^sub>0 \<union> ik\<^sub>s\<^sub>t (to_st \<A>); decomp t\<rbrakk>\<^sub>c' \<I>"
     proof -
       have "\<lbrakk>M\<^sub>0 \<union> ik\<^sub>s\<^sub>t (to_st \<A>); [send\<langle>t\<rangle>\<^sub>s\<^sub>t]\<rbrakk>\<^sub>c' \<I>"
         using Decompose.hyps(2) by (auto simp add: sup.commute)
       moreover have "\<And>k. k \<in> set K \<Longrightarrow> M\<^sub>0 \<union> ik\<^sub>s\<^sub>t (to_st \<A>) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile>\<^sub>c k \<cdot> \<I>"
         using Decompose by (metis sup.commute)
       hence "\<And>k. k \<in> set K \<Longrightarrow> \<lbrakk>M\<^sub>0 \<union> ik\<^sub>s\<^sub>t (to_st \<A>); [Send k]\<rbrakk>\<^sub>c' \<I>" by auto
       hence "\<lbrakk>M\<^sub>0 \<union> ik\<^sub>s\<^sub>t (to_st \<A>); map Send K\<rbrakk>\<^sub>c' \<I>"
         using strand_sem_Send_map(1)[of K, of "M\<^sub>0 \<union> ik\<^sub>s\<^sub>t (to_st \<A>) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" \<I>]
               strand_sem_eq_defs(1)
         by auto
       moreover have "\<lbrakk>M\<^sub>0 \<union> ik\<^sub>s\<^sub>t (to_st \<A>); map Receive M\<rbrakk>\<^sub>c' \<I>"
         by (metis strand_sem_Receive_map(1) strand_sem_eq_defs(1))
       ultimately have
           "\<lbrakk>M\<^sub>0 \<union> ik\<^sub>s\<^sub>t (to_st \<A>); send\<langle>t\<rangle>\<^sub>s\<^sub>t#map Send K@map Receive M\<rbrakk>\<^sub>c' \<I>"
         by auto
       thus ?thesis using Decompose.hyps(3) unfolding decomp_def by auto
     qed
     hence "\<lbrakk>M\<^sub>0; to_st \<A>@decomp t\<rbrakk>\<^sub>c' \<I>"
       using strand_sem_append'[of M\<^sub>0 "to_st \<A>" \<I> "decomp t"] Decompose.IH
       by simp
     thus ?case using to_st_append[of \<A> "[Decomp t]"] by simp
   qed
 qed
 
 private lemma sem\<^sub>e\<^sub>s\<^sub>t_c_decomp_rm\<^sub>e\<^sub>s\<^sub>t_deduct_aux:
   assumes "sem\<^sub>e\<^sub>s\<^sub>t_c M\<^sub>0 \<I> A" "t \<in> ik\<^sub>e\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" "t \<notin> ik\<^sub>e\<^sub>s\<^sub>t (decomp_rm\<^sub>e\<^sub>s\<^sub>t A) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>"
   shows "ik\<^sub>e\<^sub>s\<^sub>t (decomp_rm\<^sub>e\<^sub>s\<^sub>t A) \<union> M\<^sub>0 \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> t"
 using assms
 proof (induction M\<^sub>0 \<I> A arbitrary: t rule: sem\<^sub>e\<^sub>s\<^sub>t_c.induct)
   case (Send M\<^sub>0 \<I> A t') thus ?case using decomp_rm\<^sub>e\<^sub>s\<^sub>t_append ik\<^sub>e\<^sub>s\<^sub>t_append by auto
 next
   case (Receive M\<^sub>0 \<I> A t')
   hence "t \<in> ik\<^sub>e\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" "t \<notin> ik\<^sub>e\<^sub>s\<^sub>t (decomp_rm\<^sub>e\<^sub>s\<^sub>t A) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>"
     using decomp_rm\<^sub>e\<^sub>s\<^sub>t_append ik\<^sub>e\<^sub>s\<^sub>t_append by auto
   hence IH: "ik\<^sub>e\<^sub>s\<^sub>t (decomp_rm\<^sub>e\<^sub>s\<^sub>t A) \<union> M\<^sub>0 \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> t" using Receive.IH by auto
   show ?case using ideduct_mono[OF IH] decomp_rm\<^sub>e\<^sub>s\<^sub>t_append ik\<^sub>e\<^sub>s\<^sub>t_append by auto
 next
   case (Equality M\<^sub>0 \<I> A t') thus ?case using decomp_rm\<^sub>e\<^sub>s\<^sub>t_append ik\<^sub>e\<^sub>s\<^sub>t_append by auto
 next
   case (Inequality M\<^sub>0 \<I> A t') thus ?case using decomp_rm\<^sub>e\<^sub>s\<^sub>t_append ik\<^sub>e\<^sub>s\<^sub>t_append by auto
 next
   case (Decompose M\<^sub>0 \<I> A t' K M t)
   have *: "ik\<^sub>e\<^sub>s\<^sub>t (decomp_rm\<^sub>e\<^sub>s\<^sub>t A) \<union> M\<^sub>0 \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> t' \<cdot> \<I>" using Decompose.hyps(2)
   proof (induction rule: intruder_synth_induct)
     case (AxiomC t'')
     moreover {
       assume "t'' \<in> ik\<^sub>e\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" "t'' \<notin> ik\<^sub>e\<^sub>s\<^sub>t (decomp_rm\<^sub>e\<^sub>s\<^sub>t A) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>"
       hence ?case using Decompose.IH by auto
     }
     ultimately show ?case by force
   qed simp
-  
+
   { fix k assume "k \<in> set K"
     hence "ik\<^sub>e\<^sub>s\<^sub>t A \<union> M\<^sub>0 \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile>\<^sub>c k \<cdot> \<I>" using Decompose.hyps by auto
     hence "ik\<^sub>e\<^sub>s\<^sub>t (decomp_rm\<^sub>e\<^sub>s\<^sub>t A) \<union> M\<^sub>0 \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> k \<cdot> \<I>"
     proof (induction rule: intruder_synth_induct)
       case (AxiomC t'')
       moreover {
         assume "t'' \<in> ik\<^sub>e\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" "t'' \<notin> ik\<^sub>e\<^sub>s\<^sub>t (decomp_rm\<^sub>e\<^sub>s\<^sub>t A) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>"
         hence ?case using Decompose.IH by auto
       }
       ultimately show ?case by force
     qed simp
   }
   hence **: "\<And>k. k \<in> set (K \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<I>) \<Longrightarrow> ik\<^sub>e\<^sub>s\<^sub>t (decomp_rm\<^sub>e\<^sub>s\<^sub>t A) \<union> M\<^sub>0 \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> k" by auto
-  
+
   show ?case
   proof (cases "t \<in> ik\<^sub>e\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>")
     case True thus ?thesis using Decompose.IH Decompose.prems(2) decomp_rm\<^sub>e\<^sub>s\<^sub>t_append by auto
   next
     case False
     hence "t \<in> ik\<^sub>s\<^sub>t (decomp t') \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" using Decompose.prems(1) ik\<^sub>e\<^sub>s\<^sub>t_append by auto
     hence ***: "t \<in> set (M \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<I>)" using Decompose.hyps(3) decomp_ik by auto
     hence "M \<noteq> []" by auto
     hence ****: "Ana (t' \<cdot> \<I>) = (K \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<I>, M \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<I>)" using Ana_subst[OF Decompose.hyps(3)] by auto
 
     have "ik\<^sub>e\<^sub>s\<^sub>t (decomp_rm\<^sub>e\<^sub>s\<^sub>t A) \<union> M\<^sub>0 \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> t" by (rule intruder_deduct.Decompose[OF * **** ** ***])
     thus ?thesis using ideduct_mono decomp_rm\<^sub>e\<^sub>s\<^sub>t_append by auto
   qed
 qed simp
 
 private lemma sem\<^sub>e\<^sub>s\<^sub>t_c_decomp_rm\<^sub>e\<^sub>s\<^sub>t_deduct:
   assumes "sem\<^sub>e\<^sub>s\<^sub>t_c M\<^sub>0 \<I> A" "ik\<^sub>e\<^sub>s\<^sub>t A \<union> M\<^sub>0 \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile>\<^sub>c t"
   shows "ik\<^sub>e\<^sub>s\<^sub>t (decomp_rm\<^sub>e\<^sub>s\<^sub>t A) \<union> M\<^sub>0 \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> t"
 using assms(2)
 proof (induction t rule: intruder_synth_induct)
   case (AxiomC t)
   hence "t \<in> ik\<^sub>e\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<or> t \<in> M\<^sub>0 \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" by auto
   moreover {
     assume "t \<in> ik\<^sub>e\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" "t \<in> ik\<^sub>e\<^sub>s\<^sub>t (decomp_rm\<^sub>e\<^sub>s\<^sub>t A) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>"
     hence ?case using ideduct_mono[OF intruder_deduct.Axiom] by auto
   }
   moreover {
     assume "t \<in> ik\<^sub>e\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" "t \<notin> ik\<^sub>e\<^sub>s\<^sub>t (decomp_rm\<^sub>e\<^sub>s\<^sub>t A) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>"
     hence ?case using sem\<^sub>e\<^sub>s\<^sub>t_c_decomp_rm\<^sub>e\<^sub>s\<^sub>t_deduct_aux[OF assms(1)] by auto
   }
   ultimately show ?case by auto
 qed simp
 
 private lemma sem\<^sub>e\<^sub>s\<^sub>t_d_decomp_rm\<^sub>e\<^sub>s\<^sub>t_if_sem\<^sub>e\<^sub>s\<^sub>t_c: "sem\<^sub>e\<^sub>s\<^sub>t_c M\<^sub>0 \<I> A \<Longrightarrow> sem\<^sub>e\<^sub>s\<^sub>t_d M\<^sub>0 \<I> (decomp_rm\<^sub>e\<^sub>s\<^sub>t A)"
 proof (induction M\<^sub>0 \<I> A rule: sem\<^sub>e\<^sub>s\<^sub>t_c.induct)
   case (Send M\<^sub>0 \<I> A t)
   thus ?case using decomp_rm\<^sub>e\<^sub>s\<^sub>t_append sem\<^sub>e\<^sub>s\<^sub>t_d.Send[OF Send.IH] sem\<^sub>e\<^sub>s\<^sub>t_c_decomp_rm\<^sub>e\<^sub>s\<^sub>t_deduct by auto
 next
   case (Receive t) thus ?case using decomp_rm\<^sub>e\<^sub>s\<^sub>t_append sem\<^sub>e\<^sub>s\<^sub>t_d.Receive by auto
 next
   case (Equality M\<^sub>0 \<I> A t)
   thus ?case
     using decomp_rm\<^sub>e\<^sub>s\<^sub>t_append sem\<^sub>e\<^sub>s\<^sub>t_d.Equality[OF Equality.IH] sem\<^sub>e\<^sub>s\<^sub>t_c_decomp_rm\<^sub>e\<^sub>s\<^sub>t_deduct
     by auto
 next
   case (Inequality M\<^sub>0 \<I> A t)
   thus ?case
     using decomp_rm\<^sub>e\<^sub>s\<^sub>t_append sem\<^sub>e\<^sub>s\<^sub>t_d.Inequality[OF Inequality.IH] sem\<^sub>e\<^sub>s\<^sub>t_c_decomp_rm\<^sub>e\<^sub>s\<^sub>t_deduct
     by auto
 next
   case Decompose thus ?case using decomp_rm\<^sub>e\<^sub>s\<^sub>t_append by auto
 qed auto
 
 private lemma sem\<^sub>e\<^sub>s\<^sub>t_c_decomps\<^sub>e\<^sub>s\<^sub>t_append:
   assumes "sem\<^sub>e\<^sub>s\<^sub>t_c {} \<I> A" "D \<in> decomps\<^sub>e\<^sub>s\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t A) (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>) \<I>"
   shows "sem\<^sub>e\<^sub>s\<^sub>t_c {} \<I> (A@D)"
 using assms(2,1)
 proof (induction D rule: decomps\<^sub>e\<^sub>s\<^sub>t.induct)
   case (Decomp D f T K M)
   hence *: "sem\<^sub>e\<^sub>s\<^sub>t_c {} \<I> (A @ D)" "ik\<^sub>e\<^sub>s\<^sub>t (A@D) \<union> {} \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile>\<^sub>c Fun f T \<cdot> \<I>"
            "\<And>k. k \<in> set K \<Longrightarrow> ik\<^sub>e\<^sub>s\<^sub>t (A @ D) \<union> {} \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile>\<^sub>c k \<cdot> \<I>"
     using ik\<^sub>e\<^sub>s\<^sub>t_append by auto
   show ?case using sem\<^sub>e\<^sub>s\<^sub>t_c.Decompose[OF *(1,2) Decomp.hyps(3) *(3)] by simp
 qed auto
 
 private lemma decomps\<^sub>e\<^sub>s\<^sub>t_preserves_wf:
   assumes "D \<in> decomps\<^sub>e\<^sub>s\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t A) (assignment_rhs\<^sub>e\<^sub>s\<^sub>t A) \<I>" "wf\<^sub>e\<^sub>s\<^sub>t V A"
   shows "wf\<^sub>e\<^sub>s\<^sub>t V (A@D)"
 using assms
 proof (induction D rule: decomps\<^sub>e\<^sub>s\<^sub>t.induct)
   case (Decomp D f T K M)
   have "wfrestrictedvars\<^sub>s\<^sub>t (decomp (Fun f T)) \<subseteq> fv\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t A \<union> assignment_rhs\<^sub>e\<^sub>s\<^sub>t A)"
     using decomp_vars fv_subset_subterms[OF Decomp.hyps(2)] by fast
   hence "wfrestrictedvars\<^sub>s\<^sub>t (decomp (Fun f T)) \<subseteq> wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t A"
     using ik\<^sub>s\<^sub>t_assignment_rhs\<^sub>s\<^sub>t_wfrestrictedvars_subset[of "to_st A"] by blast
   hence "wfrestrictedvars\<^sub>s\<^sub>t (decomp (Fun f T)) \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t (to_st (A@D)) \<union> V"
     using to_st_append[of A D] strand_vars_split(2)[of "to_st A" "to_st D"]
     by (metis le_supI1)
   thus ?case
     using wf_append_suffix[OF Decomp.IH[OF Decomp.prems], of "decomp (Fun f T)"]
           to_st_append[of "A@D" "[Decomp (Fun f T)]"]
     by auto
 qed auto
 
 private lemma decomps\<^sub>e\<^sub>s\<^sub>t_preserves_model_c:
   assumes "D \<in> decomps\<^sub>e\<^sub>s\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t A) (assignment_rhs\<^sub>e\<^sub>s\<^sub>t A) \<I>" "sem\<^sub>e\<^sub>s\<^sub>t_c M\<^sub>0 \<I> A"
   shows "sem\<^sub>e\<^sub>s\<^sub>t_c M\<^sub>0 \<I> (A@D)"
 using assms
 proof (induction D rule: decomps\<^sub>e\<^sub>s\<^sub>t.induct)
   case (Decomp D f T K M) show ?case
     using sem\<^sub>e\<^sub>s\<^sub>t_c.Decompose[OF Decomp.IH[OF Decomp.prems] _ Decomp.hyps(3)]
           Decomp.hyps(5,6) ideduct_synth_mono ik\<^sub>e\<^sub>s\<^sub>t_append
-    by (metis (mono_tags, lifting) List.append_assoc image_Un sup_ge1) 
+    by (metis (mono_tags, lifting) List.append_assoc image_Un sup_ge1)
 qed auto
 
 private lemma decomps\<^sub>e\<^sub>s\<^sub>t_exist_aux:
   assumes "D \<in> decomps\<^sub>e\<^sub>s\<^sub>t M N \<I>" "M \<union> ik\<^sub>e\<^sub>s\<^sub>t D \<turnstile> t" "\<not>(M \<union> (ik\<^sub>e\<^sub>s\<^sub>t D) \<turnstile>\<^sub>c t)"
   obtains D' where
     "D@D' \<in> decomps\<^sub>e\<^sub>s\<^sub>t M N \<I>" "M \<union> ik\<^sub>e\<^sub>s\<^sub>t (D@D') \<turnstile>\<^sub>c t" "M \<union> ik\<^sub>e\<^sub>s\<^sub>t D \<subset> M \<union> ik\<^sub>e\<^sub>s\<^sub>t (D@D')"
 proof -
   have "\<exists>D' \<in> decomps\<^sub>e\<^sub>s\<^sub>t M N \<I>. M \<union> ik\<^sub>e\<^sub>s\<^sub>t D' \<turnstile>\<^sub>c t" using assms(2)
   proof (induction t rule: intruder_deduct_induct)
     case (Compose X f)
     from Compose.IH have "\<exists>D \<in> decomps\<^sub>e\<^sub>s\<^sub>t M N \<I>. \<forall>x \<in> set X. M \<union> ik\<^sub>e\<^sub>s\<^sub>t D \<turnstile>\<^sub>c x"
     proof (induction X)
       case (Cons t X)
       then obtain D' D'' where
           D': "D' \<in> decomps\<^sub>e\<^sub>s\<^sub>t M N \<I>" "M \<union> ik\<^sub>e\<^sub>s\<^sub>t D' \<turnstile>\<^sub>c t" and
           D'': "D'' \<in> decomps\<^sub>e\<^sub>s\<^sub>t M N \<I>" "\<forall>x \<in> set X. M \<union> ik\<^sub>e\<^sub>s\<^sub>t D'' \<turnstile>\<^sub>c x"
         by moura
       hence "M \<union> ik\<^sub>e\<^sub>s\<^sub>t (D'@D'') \<turnstile>\<^sub>c t" "\<forall>x \<in> set X. M \<union> ik\<^sub>e\<^sub>s\<^sub>t (D'@D'') \<turnstile>\<^sub>c x"
         by (auto intro: ideduct_synth_mono simp add: ik\<^sub>e\<^sub>s\<^sub>t_append)
       thus ?case using decomps\<^sub>e\<^sub>s\<^sub>t_append[OF D'(1) D''(1)] by (metis set_ConsD)
     qed (auto intro: decomps\<^sub>e\<^sub>s\<^sub>t.Nil)
     thus ?case using intruder_synth.ComposeC[OF Compose.hyps(1,2)] by metis
   next
     case (Decompose t K T t\<^sub>i)
     have "\<exists>D \<in> decomps\<^sub>e\<^sub>s\<^sub>t M N \<I>. \<forall>k \<in> set K. M \<union> ik\<^sub>e\<^sub>s\<^sub>t D \<turnstile>\<^sub>c k" using Decompose.IH
     proof (induction K)
       case (Cons t X)
       then obtain D' D'' where
           D': "D' \<in> decomps\<^sub>e\<^sub>s\<^sub>t M N \<I>" "M \<union> ik\<^sub>e\<^sub>s\<^sub>t D' \<turnstile>\<^sub>c t" and
           D'': "D'' \<in> decomps\<^sub>e\<^sub>s\<^sub>t M N \<I>" "\<forall>x \<in> set X. M \<union> ik\<^sub>e\<^sub>s\<^sub>t D'' \<turnstile>\<^sub>c x"
         using assms(1) by moura
       hence "M \<union> ik\<^sub>e\<^sub>s\<^sub>t (D'@D'') \<turnstile>\<^sub>c t" "\<forall>x \<in> set X. M \<union> ik\<^sub>e\<^sub>s\<^sub>t (D'@D'') \<turnstile>\<^sub>c x"
         by (auto intro: ideduct_synth_mono simp add: ik\<^sub>e\<^sub>s\<^sub>t_append)
       thus ?case using decomps\<^sub>e\<^sub>s\<^sub>t_append[OF D'(1) D''(1)] by auto
     qed auto
     then obtain D' where D': "D' \<in> decomps\<^sub>e\<^sub>s\<^sub>t M N \<I>" "\<And>k. k \<in> set K \<Longrightarrow> M \<union> ik\<^sub>e\<^sub>s\<^sub>t D' \<turnstile>\<^sub>c k" by metis
     obtain D'' where D'': "D'' \<in> decomps\<^sub>e\<^sub>s\<^sub>t M N \<I>" "M \<union> ik\<^sub>e\<^sub>s\<^sub>t D'' \<turnstile>\<^sub>c t" by (metis Decompose.IH(1))
     obtain f X where fX: "t = Fun f X" "t\<^sub>i \<in> set X"
       using Decompose.hyps(2,4) by (cases t) (auto dest: Ana_fun_subterm)
-  
+
     from decomps\<^sub>e\<^sub>s\<^sub>t_append[OF D'(1) D''(1)] D'(2) D''(2) have *:
         "D'@D'' \<in> decomps\<^sub>e\<^sub>s\<^sub>t M N \<I>" "\<And>k. k \<in> set K \<Longrightarrow> M \<union> ik\<^sub>e\<^sub>s\<^sub>t (D'@D'') \<turnstile>\<^sub>c k"
         "M \<union> ik\<^sub>e\<^sub>s\<^sub>t (D'@D'') \<turnstile>\<^sub>c t"
       by (auto intro: ideduct_synth_mono simp add: ik\<^sub>e\<^sub>s\<^sub>t_append)
     hence **: "\<And>k. k \<in> set K \<Longrightarrow> M \<union> ik\<^sub>e\<^sub>s\<^sub>t (D'@D'') \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile>\<^sub>c k \<cdot> \<I>"
       using ideduct_synth_subst by auto
 
     have "t\<^sub>i \<in> ik\<^sub>s\<^sub>t (decomp t)" using Decompose.hyps(2,4) ik_rcv_map unfolding decomp_def by auto
     with *(3) fX(1) Decompose.hyps(2) show ?case
     proof (induction t rule: intruder_synth_induct)
       case (AxiomC t)
       hence t_in_subterms: "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (M \<union> N)"
         using decomps\<^sub>e\<^sub>s\<^sub>t_ik_subset[OF *(1)] subset_subterms_Union
         by auto
       have "M \<union> ik\<^sub>e\<^sub>s\<^sub>t (D'@D'') \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile>\<^sub>c t \<cdot> \<I>"
         using ideduct_synth_subst[OF intruder_synth.AxiomC[OF AxiomC.hyps(1)]] by metis
       moreover have "T \<noteq> []" using decomp_ik[OF \<open>Ana t = (K,T)\<close>] \<open>t\<^sub>i \<in> ik\<^sub>s\<^sub>t (decomp t)\<close> by auto
       ultimately have "D'@D''@[Decomp (Fun f X)] \<in> decomps\<^sub>e\<^sub>s\<^sub>t M N \<I>"
         using AxiomC decomps\<^sub>e\<^sub>s\<^sub>t.Decomp[OF *(1) _ _ _ _ **] subset_subterms_Union t_in_subterms
         by (simp add: subset_eq)
       moreover have "decomp t = to_st [Decomp (Fun f X)]" using AxiomC.prems(1,2) by auto
       ultimately show ?case
         by (metis AxiomC.prems(3) UnCI intruder_synth.AxiomC ik\<^sub>e\<^sub>s\<^sub>t_append to_st_append)
     qed (auto intro!: fX(2) *(1))
   qed (fastforce intro: intruder_synth.AxiomC assms(1))
   hence "\<exists>D' \<in> decomps\<^sub>e\<^sub>s\<^sub>t M N \<I>. M \<union> ik\<^sub>e\<^sub>s\<^sub>t (D@D') \<turnstile>\<^sub>c t"
     by (auto intro: ideduct_synth_mono simp add: ik\<^sub>e\<^sub>s\<^sub>t_append)
   thus thesis using that[OF decomps\<^sub>e\<^sub>s\<^sub>t_append[OF assms(1)]] assms ik\<^sub>e\<^sub>s\<^sub>t_append by moura
 qed
 
 private lemma decomps\<^sub>e\<^sub>s\<^sub>t_ik_max_exist:
   assumes "finite A" "finite N"
   shows "\<exists>D \<in> decomps\<^sub>e\<^sub>s\<^sub>t A N \<I>. \<forall>D' \<in> decomps\<^sub>e\<^sub>s\<^sub>t A N \<I>. ik\<^sub>e\<^sub>s\<^sub>t D' \<subseteq> ik\<^sub>e\<^sub>s\<^sub>t D"
 proof -
   let ?IK = "\<lambda>M. \<Union>D \<in> M. ik\<^sub>e\<^sub>s\<^sub>t D"
   have "?IK (decomps\<^sub>e\<^sub>s\<^sub>t A N \<I>) \<subseteq> (\<Union>t \<in> A \<union> N. subterms t)" by (auto dest!: decomps\<^sub>e\<^sub>s\<^sub>t_ik_subset)
   hence "finite (?IK (decomps\<^sub>e\<^sub>s\<^sub>t A N \<I>))"
     using subterms_union_finite[OF assms(1)] subterms_union_finite[OF assms(2)] infinite_super
     by auto
   then obtain M where M: "finite M" "M \<subseteq> decomps\<^sub>e\<^sub>s\<^sub>t A N \<I>" "?IK M = ?IK (decomps\<^sub>e\<^sub>s\<^sub>t A N \<I>)"
     using finite_subset_Union by moura
   show ?thesis using decomps\<^sub>e\<^sub>s\<^sub>t_finite_ik_append[OF M(1,2)] M(3) by auto
 qed
 
 private lemma decomps\<^sub>e\<^sub>s\<^sub>t_exist:
   assumes "finite A" "finite N"
   shows "\<exists>D \<in> decomps\<^sub>e\<^sub>s\<^sub>t A N \<I>. \<forall>t. A \<turnstile> t \<longrightarrow> A \<union> ik\<^sub>e\<^sub>s\<^sub>t D \<turnstile>\<^sub>c t"
 proof (rule ccontr)
   assume neg: "\<not>(\<exists>D \<in> decomps\<^sub>e\<^sub>s\<^sub>t A N \<I>. \<forall>t. A \<turnstile> t \<longrightarrow> A \<union> ik\<^sub>e\<^sub>s\<^sub>t D \<turnstile>\<^sub>c t)"
 
   obtain D where D: "D \<in> decomps\<^sub>e\<^sub>s\<^sub>t A N \<I>" "\<forall>D' \<in> decomps\<^sub>e\<^sub>s\<^sub>t A N \<I>. ik\<^sub>e\<^sub>s\<^sub>t D' \<subseteq> ik\<^sub>e\<^sub>s\<^sub>t D"
     using decomps\<^sub>e\<^sub>s\<^sub>t_ik_max_exist[OF assms] by moura
   then obtain t where t: "A \<union> ik\<^sub>e\<^sub>s\<^sub>t D \<turnstile> t" "\<not>(A \<union> ik\<^sub>e\<^sub>s\<^sub>t D \<turnstile>\<^sub>c t)"
     using neg by (fastforce intro: ideduct_mono)
 
   obtain D' where D':
       "D@D' \<in> decomps\<^sub>e\<^sub>s\<^sub>t A N \<I>" "A \<union> ik\<^sub>e\<^sub>s\<^sub>t (D@D') \<turnstile>\<^sub>c t"
       "A \<union> ik\<^sub>e\<^sub>s\<^sub>t D \<subset> A \<union> ik\<^sub>e\<^sub>s\<^sub>t (D@D')"
     by (metis decomps\<^sub>e\<^sub>s\<^sub>t_exist_aux t D(1))
   hence "ik\<^sub>e\<^sub>s\<^sub>t D \<subset> ik\<^sub>e\<^sub>s\<^sub>t (D@D')" using ik\<^sub>e\<^sub>s\<^sub>t_append by auto
   moreover have "ik\<^sub>e\<^sub>s\<^sub>t (D@D') \<subseteq> ik\<^sub>e\<^sub>s\<^sub>t D" using D(2) D'(1) by auto
   ultimately show False by simp
 qed
 
 private lemma decomps\<^sub>e\<^sub>s\<^sub>t_exist_subst:
   assumes "ik\<^sub>e\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> t \<cdot> \<I>"
   and "sem\<^sub>e\<^sub>s\<^sub>t_c {} \<I> A" "wf\<^sub>e\<^sub>s\<^sub>t {} A" "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>"
   and "Ana_invar_subst (ik\<^sub>e\<^sub>s\<^sub>t A \<union> assignment_rhs\<^sub>e\<^sub>s\<^sub>t A)"
   and "well_analyzed A"
   shows "\<exists>D \<in> decomps\<^sub>e\<^sub>s\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t A) (assignment_rhs\<^sub>e\<^sub>s\<^sub>t A) \<I>. ik\<^sub>e\<^sub>s\<^sub>t (A@D) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile>\<^sub>c t \<cdot> \<I>"
 proof -
   have ik_eq: "ik\<^sub>e\<^sub>s\<^sub>t (A \<cdot>\<^sub>e\<^sub>s\<^sub>t \<I>) = ik\<^sub>e\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" using assms(5,6)
   proof (induction A rule: List.rev_induct)
     case (snoc a A)
     hence "Ana_invar_subst (ik\<^sub>e\<^sub>s\<^sub>t A \<union> assignment_rhs\<^sub>e\<^sub>s\<^sub>t A)"
       using Ana_invar_subst_subset[OF snoc.prems(1)] ik\<^sub>e\<^sub>s\<^sub>t_append assignment_rhs\<^sub>e\<^sub>s\<^sub>t_append
       unfolding Ana_invar_subst_def by simp
     with snoc have IH:
         "ik\<^sub>e\<^sub>s\<^sub>t (A@[a] \<cdot>\<^sub>e\<^sub>s\<^sub>t \<I>) = (ik\<^sub>e\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<union> ik\<^sub>e\<^sub>s\<^sub>t ([a] \<cdot>\<^sub>e\<^sub>s\<^sub>t \<I>)"
         "ik\<^sub>e\<^sub>s\<^sub>t (A@[a]) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> = (ik\<^sub>e\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<union> (ik\<^sub>e\<^sub>s\<^sub>t [a] \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>)"
       using well_analyzed_split_left[OF snoc.prems(2)]
       by (auto simp add: to_st_append ik\<^sub>e\<^sub>s\<^sub>t_append_subst)
-      
+
     have "ik\<^sub>e\<^sub>s\<^sub>t [a \<cdot>\<^sub>e\<^sub>s\<^sub>t\<^sub>p \<I>] = ik\<^sub>e\<^sub>s\<^sub>t [a] \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>"
     proof (cases a)
       case (Step b) thus ?thesis by (cases b) auto
     next
       case (Decomp t)
       then obtain f T where t: "t = Fun f T" using well_analyzedD[OF snoc.prems(2)] by force
       obtain K M where Ana_t: "Ana (Fun f T) = (K,M)" by (metis surj_pair)
       moreover have "Fun f T \<in> subterms\<^sub>s\<^sub>e\<^sub>t ((ik\<^sub>e\<^sub>s\<^sub>t (A@[a]) \<union> assignment_rhs\<^sub>e\<^sub>s\<^sub>t (A@[a])))"
         using t Decomp snoc.prems(2)
         by (auto dest: well_analyzed_inv simp add: ik\<^sub>e\<^sub>s\<^sub>t_append assignment_rhs\<^sub>e\<^sub>s\<^sub>t_append)
       hence "Ana (Fun f T \<cdot> \<I>) = (K \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<I>, M \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<I>)"
         using Ana_t snoc.prems(1)
-        unfolding Ana_invar_subst_def by force 
+        unfolding Ana_invar_subst_def by blast
       ultimately show ?thesis using Decomp t by (auto simp add: decomp_ik)
     qed
     thus ?case using IH unfolding subst_apply_extstrand_def by simp
   qed simp
   moreover have assignment_rhs_eq: "assignment_rhs\<^sub>e\<^sub>s\<^sub>t (A \<cdot>\<^sub>e\<^sub>s\<^sub>t \<I>) = assignment_rhs\<^sub>e\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>"
     using assms(5,6)
   proof (induction A rule: List.rev_induct)
     case (snoc a A)
     hence "Ana_invar_subst (ik\<^sub>e\<^sub>s\<^sub>t A \<union> assignment_rhs\<^sub>e\<^sub>s\<^sub>t A)"
       using Ana_invar_subst_subset[OF snoc.prems(1)] ik\<^sub>e\<^sub>s\<^sub>t_append assignment_rhs\<^sub>e\<^sub>s\<^sub>t_append
       unfolding Ana_invar_subst_def by simp
     hence "assignment_rhs\<^sub>e\<^sub>s\<^sub>t (A \<cdot>\<^sub>e\<^sub>s\<^sub>t \<I>) = assignment_rhs\<^sub>e\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>"
       using snoc.IH well_analyzed_split_left[OF snoc.prems(2)]
       by simp
     hence IH:
         "assignment_rhs\<^sub>e\<^sub>s\<^sub>t (A@[a] \<cdot>\<^sub>e\<^sub>s\<^sub>t \<I>) = (assignment_rhs\<^sub>e\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<union> assignment_rhs\<^sub>e\<^sub>s\<^sub>t ([a] \<cdot>\<^sub>e\<^sub>s\<^sub>t \<I>)"
         "assignment_rhs\<^sub>e\<^sub>s\<^sub>t (A@[a]) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> = (assignment_rhs\<^sub>e\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<union> (assignment_rhs\<^sub>e\<^sub>s\<^sub>t [a] \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>)"
       by (metis assignment_rhs\<^sub>e\<^sub>s\<^sub>t_append_subst(1), metis assignment_rhs\<^sub>e\<^sub>s\<^sub>t_append_subst(2))
 
     have "assignment_rhs\<^sub>e\<^sub>s\<^sub>t [a \<cdot>\<^sub>e\<^sub>s\<^sub>t\<^sub>p \<I>] = assignment_rhs\<^sub>e\<^sub>s\<^sub>t [a] \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>"
     proof (cases a)
       case (Step b) thus ?thesis by (cases b) auto
     next
       case (Decomp t)
       then obtain f T where t: "t = Fun f T" using well_analyzedD[OF snoc.prems(2)] by force
       obtain K M where Ana_t: "Ana (Fun f T) = (K,M)" by (metis surj_pair)
       moreover have "Fun f T \<in> subterms\<^sub>s\<^sub>e\<^sub>t ((ik\<^sub>e\<^sub>s\<^sub>t (A@[a]) \<union> assignment_rhs\<^sub>e\<^sub>s\<^sub>t (A@[a])))"
         using t Decomp snoc.prems(2)
         by (auto dest: well_analyzed_inv simp add: ik\<^sub>e\<^sub>s\<^sub>t_append assignment_rhs\<^sub>e\<^sub>s\<^sub>t_append)
       hence "Ana (Fun f T \<cdot> \<I>) = (K \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<I>, M \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<I>)"
-        using Ana_t snoc.prems(1) unfolding Ana_invar_subst_def by force 
+        using Ana_t snoc.prems(1) unfolding Ana_invar_subst_def by blast
       ultimately show ?thesis using Decomp t by (auto simp add: decomp_assignment_rhs_empty)
     qed
     thus ?case using IH unfolding subst_apply_extstrand_def by simp
   qed simp
   ultimately obtain D where D:
       "D \<in> decomps\<^sub>e\<^sub>s\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) (assignment_rhs\<^sub>e\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) Var"
       "(ik\<^sub>e\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<union> (ik\<^sub>e\<^sub>s\<^sub>t D) \<turnstile>\<^sub>c t \<cdot> \<I>"
     using decomps\<^sub>e\<^sub>s\<^sub>t_exist[OF ik\<^sub>e\<^sub>s\<^sub>t_finite assignment_rhs\<^sub>e\<^sub>s\<^sub>t_finite, of "A \<cdot>\<^sub>e\<^sub>s\<^sub>t \<I>" "A \<cdot>\<^sub>e\<^sub>s\<^sub>t \<I>"]
           ik\<^sub>e\<^sub>s\<^sub>t_append assignment_rhs\<^sub>e\<^sub>s\<^sub>t_append assms(1)
     by force
 
   let ?P = "\<lambda>D D'. \<forall>t. (ik\<^sub>e\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<union> (ik\<^sub>e\<^sub>s\<^sub>t D) \<turnstile>\<^sub>c t \<longrightarrow> (ik\<^sub>e\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<union> (ik\<^sub>e\<^sub>s\<^sub>t D' \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<turnstile>\<^sub>c t"
 
   have "\<exists>D' \<in> decomps\<^sub>e\<^sub>s\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t A) (assignment_rhs\<^sub>e\<^sub>s\<^sub>t A) \<I>. ?P D D'" using D(1)
   proof (induction D rule: decomps\<^sub>e\<^sub>s\<^sub>t.induct)
     case Nil
     have "ik\<^sub>e\<^sub>s\<^sub>t [] = ik\<^sub>e\<^sub>s\<^sub>t [] \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" by auto
     thus ?case by (metis decomps\<^sub>e\<^sub>s\<^sub>t.Nil)
   next
     case (Decomp D f T K M)
     obtain D' where D': "D' \<in> decomps\<^sub>e\<^sub>s\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t A) (assignment_rhs\<^sub>e\<^sub>s\<^sub>t A) \<I>" "?P D D'"
       using Decomp.IH by auto
     hence IH: "\<And>k. k \<in> set K \<Longrightarrow> (ik\<^sub>e\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<union> (ik\<^sub>e\<^sub>s\<^sub>t D' \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<turnstile>\<^sub>c k"
               "(ik\<^sub>e\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<union> (ik\<^sub>e\<^sub>s\<^sub>t D' \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<turnstile>\<^sub>c Fun f T"
       using Decomp.hyps(5,6) by auto
 
     have D'_ik: "ik\<^sub>e\<^sub>s\<^sub>t D' \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<subseteq> subterms\<^sub>s\<^sub>e\<^sub>t ((ik\<^sub>e\<^sub>s\<^sub>t A \<union> assignment_rhs\<^sub>e\<^sub>s\<^sub>t A)) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>"
                 "ik\<^sub>e\<^sub>s\<^sub>t D' \<subseteq> subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t A \<union> assignment_rhs\<^sub>e\<^sub>s\<^sub>t A)"
       using decomps\<^sub>e\<^sub>s\<^sub>t_ik_subset[OF D'(1)] by (metis subst_all_mono, metis)
 
     show ?case using IH(2,1) Decomp.hyps(2,3,4)
     proof (induction "Fun f T" arbitrary: f T K M rule: intruder_synth_induct)
       case (AxiomC f T)
       then obtain s where s: "s \<in> ik\<^sub>e\<^sub>s\<^sub>t A \<union> ik\<^sub>e\<^sub>s\<^sub>t D'" "Fun f T = s \<cdot> \<I>" using AxiomC.prems by blast
       hence fT_s_in: "Fun f T \<in> (subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t A \<union> assignment_rhs\<^sub>e\<^sub>s\<^sub>t A)) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>"
                      "s \<in> subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t A \<union> assignment_rhs\<^sub>e\<^sub>s\<^sub>t A)"
         using AxiomC D'_ik subset_subterms_Union[of "ik\<^sub>e\<^sub>s\<^sub>t A \<union> assignment_rhs\<^sub>e\<^sub>s\<^sub>t A"]
               subst_all_mono[OF subset_subterms_Union, of \<I>]
         by (metis (no_types) Un_iff image_eqI subset_Un_eq, metis (no_types) Un_iff subset_Un_eq)
       obtain Ks Ms where Ana_s: "Ana s = (Ks,Ms)" by moura
 
       have AD'_props: "wf\<^sub>e\<^sub>s\<^sub>t {} (A@D')" "\<lbrakk>{}; to_st (A@D')\<rbrakk>\<^sub>c \<I>"
         using decomps\<^sub>e\<^sub>s\<^sub>t_preserves_model_c[OF D'(1) assms(2)]
               decomps\<^sub>e\<^sub>s\<^sub>t_preserves_wf[OF D'(1) assms(3)]
               sem\<^sub>e\<^sub>s\<^sub>t_c_eq_sem_st strand_sem_eq_defs(1)
         by auto
 
       show ?case
       proof (cases s)
         case (Var x)
         \<comment> \<open>In this case \<open>\<I> x\<close> (is a subterm of something that) was derived from an
             "earlier intruder knowledge" because \<open>A\<close> is well-formed and has \<open>\<I>\<close> as a model.
             So either the intruder composed \<open>Fun f T\<close> himself (making \<open>Decomp (Fun f T)\<close>
             unnecessary) or \<open>Fun f T\<close> is an instance of something else in the intruder
             knowledge (in which case the "something" can be used in place of \<open>Fun f T\<close>)\<close>
         hence "Var x \<in> ik\<^sub>e\<^sub>s\<^sub>t (A@D')" "\<I> x = Fun f T" using s ik\<^sub>e\<^sub>s\<^sub>t_append by auto
 
         show ?thesis
         proof (cases "\<forall>m \<in> set M. ik\<^sub>e\<^sub>s\<^sub>t A \<union> ik\<^sub>e\<^sub>s\<^sub>t D' \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile>\<^sub>c m")
           case True
           \<comment> \<open>All terms acquired by decomposing \<open>Fun f T\<close> are already derivable.
               Hence there is no need to consider decomposition of \<open>Fun f T\<close> at all.\<close>
           have *: "(ik\<^sub>e\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<union> ik\<^sub>e\<^sub>s\<^sub>t (D@[Decomp (Fun f T)]) = (ik\<^sub>e\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<union> ik\<^sub>e\<^sub>s\<^sub>t D \<union> set M"
             using decomp_ik[OF \<open>Ana (Fun f T) = (K,M)\<close>] ik\<^sub>e\<^sub>s\<^sub>t_append[of D "[Decomp (Fun f T)]"]
             by auto
-          
+
           { fix t' assume "(ik\<^sub>e\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<union> ik\<^sub>e\<^sub>s\<^sub>t D \<union> set M \<turnstile>\<^sub>c t'"
             hence "(ik\<^sub>e\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<union> (ik\<^sub>e\<^sub>s\<^sub>t D' \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<turnstile>\<^sub>c t'"
             proof (induction t' rule: intruder_synth_induct)
               case (AxiomC t') thus ?case
               proof
                 assume "t' \<in> set M"
                 moreover have "(ik\<^sub>e\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<union> (ik\<^sub>e\<^sub>s\<^sub>t D' \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) = ik\<^sub>e\<^sub>s\<^sub>t A \<union> ik\<^sub>e\<^sub>s\<^sub>t D' \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" by auto
                 ultimately show ?case using True by auto
               qed (metis D'(2) intruder_synth.AxiomC)
             qed auto
           }
           thus ?thesis using D'(1) * by metis
         next
           case False
           \<comment> \<open>Some term acquired by decomposition of \<open>Fun f T\<close> cannot be derived in \<open>\<turnstile>\<^sub>c\<close>.
               \<open>Fun f T\<close> must therefore be an instance of something else in the intruder knowledge,
               because of well-formedness.\<close>
           then obtain t\<^sub>i where t\<^sub>i: "t\<^sub>i \<in> set T" "\<not>ik\<^sub>e\<^sub>s\<^sub>t (A@D') \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile>\<^sub>c t\<^sub>i"
             using Ana_fun_subterm[OF \<open>Ana (Fun f T) = (K,M)\<close>] by (auto simp add: ik\<^sub>e\<^sub>s\<^sub>t_append)
           obtain S where fS:
               "Fun f S \<in> subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t (A@D')) \<or>
                Fun f S \<in> subterms\<^sub>s\<^sub>e\<^sub>t (assignment_rhs\<^sub>e\<^sub>s\<^sub>t (A@D'))"
               "\<I> x = Fun f S \<cdot> \<I>"
             using strand_sem_wf_ik_or_assignment_rhs_fun_subterm[
                     OF AD'_props \<open>Var x \<in> ik\<^sub>e\<^sub>s\<^sub>t (A@D')\<close> _ t\<^sub>i \<open>interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>\<close>]
                   \<open>\<I> x = Fun f T\<close>
             by moura
           hence fS_in: "Fun f S \<cdot> \<I> \<in> ik\<^sub>e\<^sub>s\<^sub>t A \<union> ik\<^sub>e\<^sub>s\<^sub>t D' \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>"
                        "Fun f S \<in> subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t A \<union> assignment_rhs\<^sub>e\<^sub>s\<^sub>t A)"
             using imageI[OF s(1), of "\<lambda>x. x \<cdot> \<I>"] Var
                   ik\<^sub>e\<^sub>s\<^sub>t_append[of A D'] assignment_rhs\<^sub>e\<^sub>s\<^sub>t_append[of A D']
                   decomps\<^sub>e\<^sub>s\<^sub>t_subterms[OF D'(1)] decomps\<^sub>e\<^sub>s\<^sub>t_assignment_rhs_empty[OF D'(1)]
             by auto
           obtain KS MS where Ana_fS: "Ana (Fun f S) = (KS, MS)" by moura
           hence "K = KS \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<I>" "M = MS \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<I>"
             using Ana_invar_substD[OF assms(5) fS_in(2)]
                   s(2) fS(2) \<open>s = Var x\<close> \<open>Ana (Fun f T) = (K,M)\<close>
             by simp_all
           hence "MS \<noteq> []" using \<open>M \<noteq> []\<close> by simp
           have "\<And>k. k \<in> set KS \<Longrightarrow> ik\<^sub>e\<^sub>s\<^sub>t A \<union> ik\<^sub>e\<^sub>s\<^sub>t D' \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile>\<^sub>c k \<cdot> \<I>"
             using AxiomC.prems(1) \<open>K = KS \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<I>\<close> by (simp add: image_Un)
           hence D'': "D'@[Decomp (Fun f S)] \<in> decomps\<^sub>e\<^sub>s\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t A) (assignment_rhs\<^sub>e\<^sub>s\<^sub>t A) \<I>"
             using decomps\<^sub>e\<^sub>s\<^sub>t.Decomp[OF D'(1) fS_in(2) Ana_fS \<open>MS \<noteq> []\<close>] AxiomC.prems(1)
                   intruder_synth.AxiomC[OF fS_in(1)]
             by simp
           moreover {
             fix t' assume "(ik\<^sub>e\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<union> ik\<^sub>e\<^sub>s\<^sub>t (D@[Decomp (Fun f T)]) \<turnstile>\<^sub>c t'"
             hence "(ik\<^sub>e\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<union> (ik\<^sub>e\<^sub>s\<^sub>t (D'@[Decomp (Fun f S)]) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<turnstile>\<^sub>c t'"
             proof (induction t' rule: intruder_synth_induct)
               case (AxiomC t')
               hence "t' \<in> (ik\<^sub>e\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<union> ik\<^sub>e\<^sub>s\<^sub>t D \<or> t' \<in> ik\<^sub>e\<^sub>s\<^sub>t [Decomp (Fun f T)]"
                 by (simp add: ik\<^sub>e\<^sub>s\<^sub>t_append)
               thus ?case
               proof
                 assume "t' \<in> ik\<^sub>e\<^sub>s\<^sub>t [Decomp (Fun f T)]"
                 hence "t' \<in> ik\<^sub>e\<^sub>s\<^sub>t [Decomp (Fun f S)] \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>"
                   using decomp_ik \<open>Ana (Fun f T) = (K,M)\<close> \<open>Ana (Fun f S) = (KS,MS)\<close> \<open>M = MS \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<I>\<close>
                   by simp
                 thus ?case
                   using ideduct_synth_mono[
                           OF intruder_synth.AxiomC[of t' "ik\<^sub>e\<^sub>s\<^sub>t [Decomp (Fun f S)] \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>"],
                           of "(ik\<^sub>e\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<union> (ik\<^sub>e\<^sub>s\<^sub>t (D'@[Decomp (Fun f S)]) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>)"]
                   by (auto simp add: ik\<^sub>e\<^sub>s\<^sub>t_append)
               next
                 assume "t' \<in> (ik\<^sub>e\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<union> ik\<^sub>e\<^sub>s\<^sub>t D"
                 hence "(ik\<^sub>e\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<union> (ik\<^sub>e\<^sub>s\<^sub>t D' \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<turnstile>\<^sub>c t'"
                   by (metis D'(2) intruder_synth.AxiomC)
                 hence "(ik\<^sub>e\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<union> (ik\<^sub>e\<^sub>s\<^sub>t D' \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<union> (ik\<^sub>e\<^sub>s\<^sub>t [Decomp (Fun f S)] \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<turnstile>\<^sub>c t'"
                   by (simp add: ideduct_synth_mono)
                 thus ?case
                   using ik\<^sub>e\<^sub>s\<^sub>t_append[of D' "[Decomp (Fun f S)]"]
                         image_Un[of "\<lambda>x. x \<cdot> \<I>" "ik\<^sub>e\<^sub>s\<^sub>t D'" "ik\<^sub>e\<^sub>s\<^sub>t [Decomp (Fun f S)]"]
                   by (simp add: sup_aci(2))
               qed
             qed auto
           }
           ultimately show ?thesis using D'' by auto
         qed
       next
         case (Fun g S) \<comment> \<open>Hence \<open>Decomp (Fun f T)\<close> can be substituted for \<open>Decomp (Fun g S)\<close>\<close>
         hence KM: "K = Ks \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<I>" "M = Ms \<cdot>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<I>" "set K = set Ks \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" "set M = set Ms \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>"
           using fT_s_in(2) \<open>Ana (Fun f T) = (K,M)\<close> Ana_s s(2)
                 Ana_invar_substD[OF assms(5), of g S]
           by auto
         hence Ms_nonempty: "Ms \<noteq> []" using \<open>M \<noteq> []\<close> by auto
         { fix t' assume "(ik\<^sub>e\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<union> ik\<^sub>e\<^sub>s\<^sub>t (D@[Decomp (Fun f T)]) \<turnstile>\<^sub>c t'"
           hence "(ik\<^sub>e\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<union> (ik\<^sub>e\<^sub>s\<^sub>t (D'@[Decomp (Fun g S)]) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<turnstile>\<^sub>c t'" using AxiomC
           proof (induction t' rule: intruder_synth_induct)
             case (AxiomC t')
             hence "t' \<in> ik\<^sub>e\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<or> t' \<in> ik\<^sub>e\<^sub>s\<^sub>t D \<or> t' \<in> set M"
               by (simp add: decomp_ik ik\<^sub>e\<^sub>s\<^sub>t_append)
             thus ?case
             proof (elim disjE)
               assume "t' \<in> ik\<^sub>e\<^sub>s\<^sub>t D"
               hence *: "(ik\<^sub>e\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<union> (ik\<^sub>e\<^sub>s\<^sub>t D' \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<turnstile>\<^sub>c t'" using D'(2) by simp
               show ?case by (auto intro: ideduct_synth_mono[OF *] simp add: ik\<^sub>e\<^sub>s\<^sub>t_append_subst(2))
             next
               assume "t' \<in> set M"
               hence "t' \<in> ik\<^sub>e\<^sub>s\<^sub>t [Decomp (Fun g S)] \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>"
                 using KM(2) Fun decomp_ik[OF Ana_s] by auto
               thus ?case by (simp add: image_Un ik\<^sub>e\<^sub>s\<^sub>t_append)
             qed (simp add: ideduct_synth_mono[OF intruder_synth.AxiomC])
           qed auto
         }
         thus ?thesis
           using s Fun Ana_s AxiomC.prems(1) KM(3) fT_s_in
                 decomps\<^sub>e\<^sub>s\<^sub>t.Decomp[OF D'(1) _ _ Ms_nonempty, of g S Ks]
           by (metis AxiomC.hyps image_Un image_eqI intruder_synth.AxiomC)
       qed
     next
       case (ComposeC T f)
       have *: "\<And>m. m \<in> set M \<Longrightarrow> (ik\<^sub>e\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<union> (ik\<^sub>e\<^sub>s\<^sub>t D' \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<turnstile>\<^sub>c m"
         using Ana_fun_subterm[OF \<open>Ana (Fun f T) = (K, M)\<close>] ComposeC.hyps(3)
         by auto
-      
+
       have **: "ik\<^sub>e\<^sub>s\<^sub>t (D@[Decomp (Fun f T)]) = ik\<^sub>e\<^sub>s\<^sub>t D \<union> set M"
         using decomp_ik[OF \<open>Ana (Fun f T) = (K, M)\<close>] ik\<^sub>e\<^sub>s\<^sub>t_append by auto
 
       { fix t' assume "(ik\<^sub>e\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<union> ik\<^sub>e\<^sub>s\<^sub>t (D@[Decomp (Fun f T)]) \<turnstile>\<^sub>c t'"
         hence "(ik\<^sub>e\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<union> (ik\<^sub>e\<^sub>s\<^sub>t D' \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>) \<turnstile>\<^sub>c t'"
           by (induct rule: intruder_synth_induct) (auto simp add: D'(2) * **)
       }
       thus ?case using D'(1) by auto
     qed
   qed
   thus ?thesis using D(2) assms(1) by (auto simp add: ik\<^sub>e\<^sub>s\<^sub>t_append_subst(2))
 qed
 
 private lemma wf\<^sub>s\<^sub>t\<^sub>s'_update\<^sub>s\<^sub>t_nil: assumes "wf\<^sub>s\<^sub>t\<^sub>s' \<S> \<A>" shows "wf\<^sub>s\<^sub>t\<^sub>s' (update\<^sub>s\<^sub>t \<S> []) \<A>"
 using assms unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by auto
 
 private lemma wf\<^sub>s\<^sub>t\<^sub>s'_update\<^sub>s\<^sub>t_snd:
   assumes "wf\<^sub>s\<^sub>t\<^sub>s' \<S> \<A>" "send\<langle>t\<rangle>\<^sub>s\<^sub>t#S \<in> \<S>"
   shows "wf\<^sub>s\<^sub>t\<^sub>s' (update\<^sub>s\<^sub>t \<S> (send\<langle>t\<rangle>\<^sub>s\<^sub>t#S)) (\<A>@[Step (receive\<langle>t\<rangle>\<^sub>s\<^sub>t)])"
 unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def
 proof (intro conjI)
   let ?S = "send\<langle>t\<rangle>\<^sub>s\<^sub>t#S"
   let ?A = "\<A>@[Step (receive\<langle>t\<rangle>\<^sub>s\<^sub>t)]"
 
   have \<S>: "\<And>S'. S' \<in> update\<^sub>s\<^sub>t \<S> ?S \<Longrightarrow> S' = S \<or> S' \<in> \<S>" by auto
 
   have 1: "\<forall>S \<in> \<S>. wf\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t \<A>) (dual\<^sub>s\<^sub>t S)" using assms unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by auto
   moreover have 2: "wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t ?A = wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t \<A> \<union> fv t"
     using wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t_split(2) by (auto simp add: Un_assoc)
   ultimately have 3: "\<forall>S \<in> \<S>. wf\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t ?A) (dual\<^sub>s\<^sub>t S)" by (metis wf_vars_mono)
 
   have 4: "\<forall>S \<in> \<S>. \<forall>S' \<in> \<S>. fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>s\<^sub>t S' = {}" using assms unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by simp
 
   have "wf\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t ?A) (dual\<^sub>s\<^sub>t S)" using 1 2 3 assms(2) by auto
   thus "\<forall>S \<in> update\<^sub>s\<^sub>t \<S> ?S. wf\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t ?A) (dual\<^sub>s\<^sub>t S)" by (metis 3 \<S>)
-  
+
   have "fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>s\<^sub>t S = {}"
        "\<forall>S' \<in> \<S>. fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>s\<^sub>t S' = {}"
        "\<forall>S' \<in> \<S>. fv\<^sub>s\<^sub>t S' \<inter> bvars\<^sub>s\<^sub>t S = {}"
     using 4 assms(2) unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by force+
   thus "\<forall>S \<in> update\<^sub>s\<^sub>t \<S> ?S. \<forall>S' \<in> update\<^sub>s\<^sub>t \<S> ?S. fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>s\<^sub>t S' = {}" by (metis 4 \<S>)
 
   have "\<forall>S' \<in> \<S>. fv\<^sub>s\<^sub>t ?S \<inter> bvars\<^sub>s\<^sub>t S' = {}" "\<forall>S' \<in> \<S>. fv\<^sub>s\<^sub>t S' \<inter> bvars\<^sub>s\<^sub>t ?S = {}"
     using assms unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by metis+
   hence 5: "fv\<^sub>e\<^sub>s\<^sub>t ?A = fv\<^sub>e\<^sub>s\<^sub>t \<A> \<union> fv t" "bvars\<^sub>e\<^sub>s\<^sub>t ?A = bvars\<^sub>e\<^sub>s\<^sub>t \<A>" "\<forall>S' \<in> \<S>. fv t \<inter> bvars\<^sub>s\<^sub>t S' = {}"
     using to_st_append by fastforce+
 
   have *: "\<forall>S \<in> \<S>. fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>e\<^sub>s\<^sub>t ?A = {}"
     using 5 assms(1) unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by fast
   hence "fv\<^sub>s\<^sub>t ?S \<inter> bvars\<^sub>e\<^sub>s\<^sub>t ?A = {}" using assms(2) by metis
   hence "fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>e\<^sub>s\<^sub>t ?A = {}" by auto
   thus "\<forall>S \<in> update\<^sub>s\<^sub>t \<S> ?S. fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>e\<^sub>s\<^sub>t ?A = {}" by (metis * \<S>)
 
   have **: "\<forall>S \<in> \<S>. fv\<^sub>e\<^sub>s\<^sub>t ?A \<inter> bvars\<^sub>s\<^sub>t S = {}"
     using 5 assms(1) unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by fast
   hence "fv\<^sub>e\<^sub>s\<^sub>t ?A \<inter> bvars\<^sub>s\<^sub>t ?S = {}" using assms(2) by metis
   hence "fv\<^sub>e\<^sub>s\<^sub>t ?A \<inter> bvars\<^sub>s\<^sub>t S = {}" by fastforce
   thus "\<forall>S \<in> update\<^sub>s\<^sub>t \<S> ?S. fv\<^sub>e\<^sub>s\<^sub>t ?A \<inter> bvars\<^sub>s\<^sub>t S = {}" by (metis ** \<S>)
 qed
 
 private lemma wf\<^sub>s\<^sub>t\<^sub>s'_update\<^sub>s\<^sub>t_rcv:
   assumes "wf\<^sub>s\<^sub>t\<^sub>s' \<S> \<A>" "receive\<langle>t\<rangle>\<^sub>s\<^sub>t#S \<in> \<S>"
   shows "wf\<^sub>s\<^sub>t\<^sub>s' (update\<^sub>s\<^sub>t \<S> (receive\<langle>t\<rangle>\<^sub>s\<^sub>t#S)) (\<A>@[Step (send\<langle>t\<rangle>\<^sub>s\<^sub>t)])"
 unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def
 proof (intro conjI)
   let ?S = "receive\<langle>t\<rangle>\<^sub>s\<^sub>t#S"
   let ?A = "\<A>@[Step (send\<langle>t\<rangle>\<^sub>s\<^sub>t)]"
 
   have \<S>: "\<And>S'. S' \<in> update\<^sub>s\<^sub>t \<S> ?S \<Longrightarrow> S' = S \<or> S' \<in> \<S>" by auto
 
   have 1: "\<forall>S \<in> \<S>. wf\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t \<A>) (dual\<^sub>s\<^sub>t S)" using assms unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by auto
   moreover have 2: "wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t ?A = wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t \<A> \<union> fv t"
     using wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t_split(2) by (auto simp add: Un_assoc)
   ultimately have 3: "\<forall>S \<in> \<S>. wf\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t ?A) (dual\<^sub>s\<^sub>t S)" by (metis wf_vars_mono)
 
   have 4: "\<forall>S \<in> \<S>. \<forall>S' \<in> \<S>. fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>s\<^sub>t S' = {}" using assms unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by simp
 
   have "wf\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t ?A) (dual\<^sub>s\<^sub>t S)" using 1 2 3 assms(2) by auto
   thus "\<forall>S \<in> update\<^sub>s\<^sub>t \<S> ?S. wf\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t ?A) (dual\<^sub>s\<^sub>t S)" by (metis 3 \<S>)
 
   have "fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>s\<^sub>t S = {}"
        "\<forall>S' \<in> \<S>. fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>s\<^sub>t S' = {}"
        "\<forall>S' \<in> \<S>. fv\<^sub>s\<^sub>t S' \<inter> bvars\<^sub>s\<^sub>t S = {}"
     using 4 assms(2) unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by force+
   thus "\<forall>S \<in> update\<^sub>s\<^sub>t \<S> ?S. \<forall>S' \<in> update\<^sub>s\<^sub>t \<S> ?S. fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>s\<^sub>t S' = {}" by (metis 4 \<S>)
 
   have "\<forall>S' \<in> \<S>. fv\<^sub>s\<^sub>t ?S \<inter> bvars\<^sub>s\<^sub>t S' = {}" "\<forall>S' \<in> \<S>. fv\<^sub>s\<^sub>t S' \<inter> bvars\<^sub>s\<^sub>t ?S = {}"
     using assms unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by metis+
   hence 5: "fv\<^sub>e\<^sub>s\<^sub>t ?A = fv\<^sub>e\<^sub>s\<^sub>t \<A> \<union> fv t" "bvars\<^sub>e\<^sub>s\<^sub>t ?A = bvars\<^sub>e\<^sub>s\<^sub>t \<A>" "\<forall>S' \<in> \<S>. fv t \<inter> bvars\<^sub>s\<^sub>t S' = {}"
     using to_st_append by fastforce+
 
   have *: "\<forall>S \<in> \<S>. fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>e\<^sub>s\<^sub>t ?A = {}"
     using 5 assms(1) unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by fast
   hence "fv\<^sub>s\<^sub>t ?S \<inter> bvars\<^sub>e\<^sub>s\<^sub>t ?A = {}" using assms(2) by metis
   hence "fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>e\<^sub>s\<^sub>t ?A = {}" by auto
   thus "\<forall>S \<in> update\<^sub>s\<^sub>t \<S> ?S. fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>e\<^sub>s\<^sub>t ?A = {}" by (metis * \<S>)
 
   have **: "\<forall>S \<in> \<S>. fv\<^sub>e\<^sub>s\<^sub>t ?A \<inter> bvars\<^sub>s\<^sub>t S = {}"
     using 5 assms(1) unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by fast
   hence "fv\<^sub>e\<^sub>s\<^sub>t ?A \<inter> bvars\<^sub>s\<^sub>t ?S = {}" using assms(2) by metis
   hence "fv\<^sub>e\<^sub>s\<^sub>t ?A \<inter> bvars\<^sub>s\<^sub>t S = {}" by fastforce
   thus "\<forall>S \<in> update\<^sub>s\<^sub>t \<S> ?S. fv\<^sub>e\<^sub>s\<^sub>t ?A \<inter> bvars\<^sub>s\<^sub>t S = {}" by (metis ** \<S>)
 qed
 
 private lemma wf\<^sub>s\<^sub>t\<^sub>s'_update\<^sub>s\<^sub>t_eq:
   assumes "wf\<^sub>s\<^sub>t\<^sub>s' \<S> \<A>" "\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t#S \<in> \<S>"
   shows "wf\<^sub>s\<^sub>t\<^sub>s' (update\<^sub>s\<^sub>t \<S> (\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t#S)) (\<A>@[Step (\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t)])"
 unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def
 proof (intro conjI)
   let ?S = "\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t#S"
   let ?A = "\<A>@[Step (\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t)]"
 
   have \<S>: "\<And>S'. S' \<in> update\<^sub>s\<^sub>t \<S> ?S \<Longrightarrow> S' = S \<or> S' \<in> \<S>" by auto
 
   have 1: "\<forall>S \<in> \<S>. wf\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t \<A>) (dual\<^sub>s\<^sub>t S)" using assms unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by auto
   moreover have 2:
       "a = Assign \<Longrightarrow> wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t ?A = wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t \<A> \<union> fv t \<union> fv t'"
       "a = Check \<Longrightarrow> wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t ?A = wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t \<A>"
     using wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t_split(2) by (auto simp add: Un_assoc)
   ultimately have 3: "\<forall>S \<in> \<S>. wf\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t ?A) (dual\<^sub>s\<^sub>t S)"
     by (cases a) (metis wf_vars_mono, metis)
 
   have 4: "\<forall>S \<in> \<S>. \<forall>S' \<in> \<S>. fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>s\<^sub>t S' = {}" using assms unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by simp
 
   have "wf\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t ?A) (dual\<^sub>s\<^sub>t S)" using 1 2 3 assms(2) by (cases a) auto
   thus "\<forall>S \<in> update\<^sub>s\<^sub>t \<S> ?S. wf\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t ?A) (dual\<^sub>s\<^sub>t S)" by (metis 3 \<S>)
 
   have "fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>s\<^sub>t S = {}"
        "\<forall>S' \<in> \<S>. fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>s\<^sub>t S' = {}"
        "\<forall>S' \<in> \<S>. fv\<^sub>s\<^sub>t S' \<inter> bvars\<^sub>s\<^sub>t S = {}"
     using 4 assms(2) unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by force+
   thus "\<forall>S \<in> update\<^sub>s\<^sub>t \<S> ?S. \<forall>S' \<in> update\<^sub>s\<^sub>t \<S> ?S. fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>s\<^sub>t S' = {}" by (metis 4 \<S>)
 
   have "\<forall>S' \<in> \<S>. fv\<^sub>s\<^sub>t ?S \<inter> bvars\<^sub>s\<^sub>t S' = {}" "\<forall>S' \<in> \<S>. fv\<^sub>s\<^sub>t S' \<inter> bvars\<^sub>s\<^sub>t ?S = {}"
     using assms unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by metis+
   hence 5: "fv\<^sub>e\<^sub>s\<^sub>t ?A = fv\<^sub>e\<^sub>s\<^sub>t \<A> \<union> fv t \<union> fv t'" "bvars\<^sub>e\<^sub>s\<^sub>t ?A = bvars\<^sub>e\<^sub>s\<^sub>t \<A>"
            "\<forall>S' \<in> \<S>. fv t \<inter> bvars\<^sub>s\<^sub>t S' = {}" "\<forall>S' \<in> \<S>. fv t' \<inter> bvars\<^sub>s\<^sub>t S' = {}"
     using to_st_append by fastforce+
 
   have *: "\<forall>S \<in> \<S>. fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>e\<^sub>s\<^sub>t ?A = {}"
     using 5 assms(1) unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by fast
   hence "fv\<^sub>s\<^sub>t ?S \<inter> bvars\<^sub>e\<^sub>s\<^sub>t ?A = {}" using assms(2) by metis
   hence "fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>e\<^sub>s\<^sub>t ?A = {}" by auto
   thus "\<forall>S \<in> update\<^sub>s\<^sub>t \<S> ?S. fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>e\<^sub>s\<^sub>t ?A = {}" by (metis * \<S>)
 
   have **: "\<forall>S \<in> \<S>. fv\<^sub>e\<^sub>s\<^sub>t ?A \<inter> bvars\<^sub>s\<^sub>t S = {}"
     using 5 assms(1) unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by fast
   hence "fv\<^sub>e\<^sub>s\<^sub>t ?A \<inter> bvars\<^sub>s\<^sub>t ?S = {}" using assms(2) by metis
   hence "fv\<^sub>e\<^sub>s\<^sub>t ?A \<inter> bvars\<^sub>s\<^sub>t S = {}" by fastforce
   thus "\<forall>S \<in> update\<^sub>s\<^sub>t \<S> ?S. fv\<^sub>e\<^sub>s\<^sub>t ?A \<inter> bvars\<^sub>s\<^sub>t S = {}" by (metis ** \<S>)
 qed
 
 private lemma wf\<^sub>s\<^sub>t\<^sub>s'_update\<^sub>s\<^sub>t_ineq:
   assumes "wf\<^sub>s\<^sub>t\<^sub>s' \<S> \<A>" "\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t#S \<in> \<S>"
   shows "wf\<^sub>s\<^sub>t\<^sub>s' (update\<^sub>s\<^sub>t \<S> (\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t#S)) (\<A>@[Step (\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t)])"
 unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def
 proof (intro conjI)
   let ?S = "\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t#S"
   let ?A = "\<A>@[Step (\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t)]"
 
   have \<S>: "\<And>S'. S' \<in> update\<^sub>s\<^sub>t \<S> ?S \<Longrightarrow> S' = S \<or> S' \<in> \<S>" by auto
 
   have 1: "\<forall>S \<in> \<S>. wf\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t \<A>) (dual\<^sub>s\<^sub>t S)" using assms unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by auto
   moreover have 2: "wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t ?A = wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t \<A>"
     using wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t_split(2) by (auto simp add: Un_assoc)
   ultimately have 3: "\<forall>S \<in> \<S>. wf\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t ?A) (dual\<^sub>s\<^sub>t S)" by metis
 
   have 4: "\<forall>S \<in> \<S>. \<forall>S' \<in> \<S>. fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>s\<^sub>t S' = {}" using assms unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by simp
 
   have "wf\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t ?A) (dual\<^sub>s\<^sub>t S)" using 1 2 3 assms(2) by auto
   thus "\<forall>S \<in> update\<^sub>s\<^sub>t \<S> ?S. wf\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t ?A) (dual\<^sub>s\<^sub>t S)" by (metis 3 \<S>)
 
   have "fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>s\<^sub>t S = {}"
        "\<forall>S' \<in> \<S>. fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>s\<^sub>t S' = {}"
        "\<forall>S' \<in> \<S>. fv\<^sub>s\<^sub>t S' \<inter> bvars\<^sub>s\<^sub>t S = {}"
     using 4 assms(2) unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by force+
   thus "\<forall>S \<in> update\<^sub>s\<^sub>t \<S> ?S. \<forall>S' \<in> update\<^sub>s\<^sub>t \<S> ?S. fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>s\<^sub>t S' = {}" by (metis 4 \<S>)
 
   have "\<forall>S' \<in> \<S>. fv\<^sub>s\<^sub>t ?S \<inter> bvars\<^sub>s\<^sub>t S' = {}" "\<forall>S' \<in> \<S>. fv\<^sub>s\<^sub>t S' \<inter> bvars\<^sub>s\<^sub>t ?S = {}"
     using assms unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by metis+
   moreover have "fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X \<subseteq> fv\<^sub>s\<^sub>t (\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t # S)" by auto
   ultimately have 5:
       "\<forall>S' \<in> \<S>. (fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X) \<inter> bvars\<^sub>s\<^sub>t S' = {}"
-      "fv\<^sub>e\<^sub>s\<^sub>t ?A = fv\<^sub>e\<^sub>s\<^sub>t \<A> \<union> (fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X)" "bvars\<^sub>e\<^sub>s\<^sub>t ?A = set X \<union> bvars\<^sub>e\<^sub>s\<^sub>t \<A>" 
+      "fv\<^sub>e\<^sub>s\<^sub>t ?A = fv\<^sub>e\<^sub>s\<^sub>t \<A> \<union> (fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X)" "bvars\<^sub>e\<^sub>s\<^sub>t ?A = set X \<union> bvars\<^sub>e\<^sub>s\<^sub>t \<A>"
       "\<forall>S \<in> \<S>. fv\<^sub>s\<^sub>t S \<inter> set X = {}"
     using to_st_append
     by (blast, force, force, force)
 
   have *: "\<forall>S \<in> \<S>. fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>e\<^sub>s\<^sub>t ?A = {}" using 5(3,4) assms(1) unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by blast
   hence "fv\<^sub>s\<^sub>t ?S \<inter> bvars\<^sub>e\<^sub>s\<^sub>t ?A = {}" using assms(2) by metis
   hence "fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>e\<^sub>s\<^sub>t ?A = {}" by auto
   thus "\<forall>S \<in> update\<^sub>s\<^sub>t \<S> ?S. fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>e\<^sub>s\<^sub>t ?A = {}" by (metis * \<S>)
 
   have **: "\<forall>S \<in> \<S>. fv\<^sub>e\<^sub>s\<^sub>t ?A \<inter> bvars\<^sub>s\<^sub>t S = {}"
     using 5(1,2) assms(1) unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by fast
   hence "fv\<^sub>e\<^sub>s\<^sub>t ?A \<inter> bvars\<^sub>s\<^sub>t ?S = {}" using assms(2) by metis
   hence "fv\<^sub>e\<^sub>s\<^sub>t ?A \<inter> bvars\<^sub>s\<^sub>t S = {}" by auto
   thus "\<forall>S \<in> update\<^sub>s\<^sub>t \<S> ?S. fv\<^sub>e\<^sub>s\<^sub>t ?A \<inter> bvars\<^sub>s\<^sub>t S = {}" by (metis ** \<S>)
 qed
 
 private lemma trms\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_eq:
   assumes "x#S \<in> \<S>"
   shows "\<Union>(trms\<^sub>s\<^sub>t ` update\<^sub>s\<^sub>t \<S> (x#S)) \<union> trms\<^sub>s\<^sub>t\<^sub>p x = \<Union>(trms\<^sub>s\<^sub>t ` \<S>)" (is "?A = ?B")
 proof
   show "?B \<subseteq> ?A"
   proof
     have "trms\<^sub>s\<^sub>t\<^sub>p x \<subseteq> trms\<^sub>s\<^sub>t (x#S)" by auto
     hence "\<And>t'. t' \<in> ?B \<Longrightarrow> t' \<in> trms\<^sub>s\<^sub>t\<^sub>p x \<Longrightarrow> t' \<in> ?A" by simp
     moreover {
       fix t' assume t': "t' \<in> ?B" "t' \<notin> trms\<^sub>s\<^sub>t\<^sub>p x"
       then obtain S' where S': "t' \<in> trms\<^sub>s\<^sub>t S'" "S' \<in> \<S>" by auto
       hence "S' = x#S \<or> S' \<in> update\<^sub>s\<^sub>t \<S> (x#S)" by auto
       moreover {
         assume "S' = x#S"
         hence "t' \<in> trms\<^sub>s\<^sub>t S" using S' t' by simp
         hence "t' \<in> ?A" by auto
       }
       ultimately have "t' \<in> ?A" using t' S' by auto
     }
     ultimately show "\<And>t'. t' \<in> ?B \<Longrightarrow> t' \<in> ?A" by metis
   qed
 
   show "?A \<subseteq> ?B"
   proof
     have "\<And>t'. t' \<in> ?A \<Longrightarrow> t' \<in> trms\<^sub>s\<^sub>t\<^sub>p x \<Longrightarrow> trms\<^sub>s\<^sub>t\<^sub>p x \<subseteq> ?B"
       using assms by force+
     moreover {
       fix t' assume t': "t' \<in> ?A" "t' \<notin> trms\<^sub>s\<^sub>t\<^sub>p x"
       then obtain S' where "t' \<in> trms\<^sub>s\<^sub>t S'" "S' \<in> update\<^sub>s\<^sub>t \<S> (x#S)" by auto
       hence "S' = S \<or> S' \<in> \<S>" by auto
       moreover have "trms\<^sub>s\<^sub>t S \<subseteq> ?B" using assms trms\<^sub>s\<^sub>t_cons[of x S] by blast
       ultimately have "t' \<in> ?B" using t' by fastforce
     }
     ultimately show "\<And>t'. t' \<in> ?A \<Longrightarrow> t' \<in> ?B" by blast
   qed
 qed
 
 private lemma trms\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_eq_snd:
   assumes "send\<langle>t\<rangle>\<^sub>s\<^sub>t#S \<in> \<S>" "\<S>' = update\<^sub>s\<^sub>t \<S> (send\<langle>t\<rangle>\<^sub>s\<^sub>t#S)" "\<A>' = \<A>@[Step (receive\<langle>t\<rangle>\<^sub>s\<^sub>t)]"
   shows "(\<Union>(trms\<^sub>s\<^sub>t ` \<S>)) \<union> (trms\<^sub>e\<^sub>s\<^sub>t \<A>) = (\<Union>(trms\<^sub>s\<^sub>t ` \<S>')) \<union> (trms\<^sub>e\<^sub>s\<^sub>t \<A>')"
 proof -
   have "(trms\<^sub>e\<^sub>s\<^sub>t \<A>') = (trms\<^sub>e\<^sub>s\<^sub>t \<A>) \<union> {t}" "\<Union>(trms\<^sub>s\<^sub>t ` \<S>') \<union> {t} = \<Union>(trms\<^sub>s\<^sub>t ` \<S>)"
     using to_st_append trms\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_eq[OF assms(1)] assms(2,3) by auto
   thus ?thesis
     by (metis (no_types, lifting) Un_insert_left Un_insert_right sup_bot.right_neutral)
 qed
 
 private lemma trms\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_eq_rcv:
   assumes "receive\<langle>t\<rangle>\<^sub>s\<^sub>t#S \<in> \<S>" "\<S>' = update\<^sub>s\<^sub>t \<S> (receive\<langle>t\<rangle>\<^sub>s\<^sub>t#S)" "\<A>' = \<A>@[Step (send\<langle>t\<rangle>\<^sub>s\<^sub>t)]"
   shows "(\<Union>(trms\<^sub>s\<^sub>t ` \<S>)) \<union> (trms\<^sub>e\<^sub>s\<^sub>t \<A>) = (\<Union>(trms\<^sub>s\<^sub>t ` \<S>')) \<union> (trms\<^sub>e\<^sub>s\<^sub>t \<A>')"
 proof -
   have "(trms\<^sub>e\<^sub>s\<^sub>t \<A>') = (trms\<^sub>e\<^sub>s\<^sub>t \<A>) \<union> {t}" "\<Union>(trms\<^sub>s\<^sub>t ` \<S>') \<union> {t} = \<Union>(trms\<^sub>s\<^sub>t ` \<S>)"
     using to_st_append trms\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_eq[OF assms(1)] assms(2,3) by auto
   thus ?thesis
-    by (metis (no_types, lifting) Un_insert_left Un_insert_right sup_bot.right_neutral) 
+    by (metis (no_types, lifting) Un_insert_left Un_insert_right sup_bot.right_neutral)
 qed
 
 private lemma trms\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_eq_eq:
   assumes "\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t#S \<in> \<S>" "\<S>' = update\<^sub>s\<^sub>t \<S> (\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t#S)" "\<A>' = \<A>@[Step (\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t)]"
   shows "(\<Union>(trms\<^sub>s\<^sub>t ` \<S>)) \<union> (trms\<^sub>e\<^sub>s\<^sub>t \<A>) = (\<Union>(trms\<^sub>s\<^sub>t ` \<S>')) \<union> (trms\<^sub>e\<^sub>s\<^sub>t \<A>')"
 proof -
   have "(trms\<^sub>e\<^sub>s\<^sub>t \<A>') = (trms\<^sub>e\<^sub>s\<^sub>t \<A>) \<union> {t,t'}" "\<Union>(trms\<^sub>s\<^sub>t ` \<S>') \<union> {t,t'} = \<Union>(trms\<^sub>s\<^sub>t ` \<S>)"
     using to_st_append trms\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_eq[OF assms(1)] assms(2,3) by auto
   thus ?thesis
     by (metis (no_types, lifting) Un_insert_left Un_insert_right sup_bot.right_neutral)
 qed
 
 private lemma trms\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_eq_ineq:
   assumes "\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t#S \<in> \<S>" "\<S>' = update\<^sub>s\<^sub>t \<S> (\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t#S)" "\<A>' = \<A>@[Step (\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t)]"
   shows "(\<Union>(trms\<^sub>s\<^sub>t ` \<S>)) \<union> (trms\<^sub>e\<^sub>s\<^sub>t \<A>) = (\<Union>(trms\<^sub>s\<^sub>t ` \<S>')) \<union> (trms\<^sub>e\<^sub>s\<^sub>t \<A>')"
 proof -
   have "(trms\<^sub>e\<^sub>s\<^sub>t \<A>') = (trms\<^sub>e\<^sub>s\<^sub>t \<A>) \<union> trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F" "\<Union>(trms\<^sub>s\<^sub>t ` \<S>') \<union> trms\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F = \<Union>(trms\<^sub>s\<^sub>t ` \<S>)"
     using to_st_append trms\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_eq[OF assms(1)] assms(2,3) by auto
   thus ?thesis by (simp add: Un_commute sup_left_commute)
 qed
 
 private lemma ik\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_subset:
   assumes "x#S \<in> \<S>"
   shows "\<Union>(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t ` (update\<^sub>s\<^sub>t \<S> (x#S))) \<subseteq> \<Union>(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t ` \<S>)" (is ?A)
         "\<Union>(assignment_rhs\<^sub>s\<^sub>t ` (update\<^sub>s\<^sub>t \<S> (x#S))) \<subseteq> \<Union>(assignment_rhs\<^sub>s\<^sub>t ` \<S>)" (is ?B)
 proof -
   { fix t assume "t \<in> \<Union>(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t ` (update\<^sub>s\<^sub>t \<S> (x#S)))"
     then obtain S' where S': "S' \<in> update\<^sub>s\<^sub>t \<S> (x#S)" "t \<in> ik\<^sub>s\<^sub>t (dual\<^sub>s\<^sub>t S')" by auto
-  
+
     have *: "ik\<^sub>s\<^sub>t (dual\<^sub>s\<^sub>t S) \<subseteq> ik\<^sub>s\<^sub>t (dual\<^sub>s\<^sub>t (x#S))"
       using ik_append[of "dual\<^sub>s\<^sub>t [x]" "dual\<^sub>s\<^sub>t S"] dual\<^sub>s\<^sub>t_append[of "[x]" S]
       by auto
-  
+
     hence "t \<in> \<Union>(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t ` \<S>)"
     proof (cases "S' = S")
       case True thus ?thesis using * assms S' by auto
     next
       case False thus ?thesis using S' by auto
     qed
   }
   moreover
   { fix t assume "t \<in> \<Union>(assignment_rhs\<^sub>s\<^sub>t ` (update\<^sub>s\<^sub>t \<S> (x#S)))"
     then obtain S' where S': "S' \<in> update\<^sub>s\<^sub>t \<S> (x#S)" "t \<in> assignment_rhs\<^sub>s\<^sub>t S'" by auto
-  
+
     have "assignment_rhs\<^sub>s\<^sub>t S \<subseteq> assignment_rhs\<^sub>s\<^sub>t (x#S)"
       using assignment_rhs_append[of "[x]" S] by simp
     hence "t \<in> \<Union>(assignment_rhs\<^sub>s\<^sub>t ` \<S>)"
       using assms S' by (cases "S' = S") auto
   }
   ultimately show ?A ?B by (metis subsetI)+
 qed
 
 private lemma ik\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_subset_snd:
   assumes "send\<langle>t\<rangle>\<^sub>s\<^sub>t#S \<in> \<S>"
           "\<S>' = update\<^sub>s\<^sub>t \<S> (send\<langle>t\<rangle>\<^sub>s\<^sub>t#S)"
           "\<A>' = \<A>@[Step (receive\<langle>t\<rangle>\<^sub>s\<^sub>t)]"
   shows "(\<Union>(ik\<^sub>s\<^sub>t ` dual\<^sub>s\<^sub>t ` \<S>')) \<union> (ik\<^sub>e\<^sub>s\<^sub>t \<A>') \<subseteq>
          (\<Union>(ik\<^sub>s\<^sub>t ` dual\<^sub>s\<^sub>t ` \<S>)) \<union> (ik\<^sub>e\<^sub>s\<^sub>t \<A>)" (is ?A)
         "(\<Union>(assignment_rhs\<^sub>s\<^sub>t ` \<S>')) \<union> (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>') \<subseteq>
          (\<Union>(assignment_rhs\<^sub>s\<^sub>t ` \<S>)) \<union> (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>)" (is ?B)
 proof -
   { fix t' assume t'_in: "t' \<in> (\<Union>(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t ` \<S>')) \<union> (ik\<^sub>e\<^sub>s\<^sub>t \<A>')"
     hence "t' \<in> (\<Union>(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t ` \<S>')) \<union> (ik\<^sub>e\<^sub>s\<^sub>t \<A>) \<union> {t}" using assms ik\<^sub>e\<^sub>s\<^sub>t_append by auto
     moreover have "t \<in> \<Union>(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t ` \<S>)" using assms(1) by force
     ultimately have "t' \<in> (\<Union>(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t ` \<S>)) \<union> (ik\<^sub>e\<^sub>s\<^sub>t \<A>)"
       using ik\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_subset[OF assms(1)] assms(2) by auto
   }
   moreover
   { fix t' assume t'_in: "t' \<in> (\<Union>(assignment_rhs\<^sub>s\<^sub>t ` \<S>')) \<union> (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>')"
     hence "t' \<in> (\<Union>(assignment_rhs\<^sub>s\<^sub>t ` \<S>')) \<union> (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>)"
       using assms assignment_rhs\<^sub>e\<^sub>s\<^sub>t_append by auto
     hence "t' \<in> (\<Union>(assignment_rhs\<^sub>s\<^sub>t ` \<S>)) \<union> (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>)"
       using ik\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_subset[OF assms(1)] assms(2) by auto
   }
   ultimately show ?A ?B by (metis subsetI)+
 qed
 
 private lemma ik\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_subset_rcv:
   assumes "receive\<langle>t\<rangle>\<^sub>s\<^sub>t#S \<in> \<S>"
           "\<S>' = update\<^sub>s\<^sub>t \<S> (receive\<langle>t\<rangle>\<^sub>s\<^sub>t#S)"
           "\<A>' = \<A>@[Step (send\<langle>t\<rangle>\<^sub>s\<^sub>t)]"
   shows "(\<Union>(ik\<^sub>s\<^sub>t ` dual\<^sub>s\<^sub>t ` \<S>')) \<union> (ik\<^sub>e\<^sub>s\<^sub>t \<A>') \<subseteq>
          (\<Union>(ik\<^sub>s\<^sub>t ` dual\<^sub>s\<^sub>t ` \<S>)) \<union> (ik\<^sub>e\<^sub>s\<^sub>t \<A>)" (is ?A)
         "(\<Union>(assignment_rhs\<^sub>s\<^sub>t ` \<S>')) \<union> (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>') \<subseteq>
          (\<Union>(assignment_rhs\<^sub>s\<^sub>t ` \<S>)) \<union> (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>)" (is ?B)
 proof -
   { fix t' assume t'_in: "t' \<in> (\<Union>(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t ` \<S>')) \<union> (ik\<^sub>e\<^sub>s\<^sub>t \<A>')"
     hence "t' \<in> (\<Union>(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t ` \<S>')) \<union> (ik\<^sub>e\<^sub>s\<^sub>t \<A>)" using assms ik\<^sub>e\<^sub>s\<^sub>t_append by auto
     hence "t' \<in> (\<Union>(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t ` \<S>)) \<union> (ik\<^sub>e\<^sub>s\<^sub>t \<A>)"
       using ik\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_subset[OF assms(1)] assms(2) by auto
   }
   moreover
   { fix t' assume t'_in: "t' \<in> (\<Union>(assignment_rhs\<^sub>s\<^sub>t ` \<S>')) \<union> (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>')"
     hence "t' \<in> (\<Union>(assignment_rhs\<^sub>s\<^sub>t ` \<S>')) \<union> (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>)"
       using assms assignment_rhs\<^sub>e\<^sub>s\<^sub>t_append by auto
     hence "t' \<in> (\<Union>(assignment_rhs\<^sub>s\<^sub>t ` \<S>)) \<union> (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>)"
       using ik\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_subset[OF assms(1)] assms(2) by auto
   }
   ultimately show ?A ?B by (metis subsetI)+
 qed
 
 private lemma ik\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_subset_eq:
   assumes "\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t#S \<in> \<S>"
           "\<S>' = update\<^sub>s\<^sub>t \<S> (\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t#S)"
           "\<A>' = \<A>@[Step (\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t)]"
   shows "(\<Union>(ik\<^sub>s\<^sub>t ` dual\<^sub>s\<^sub>t ` \<S>')) \<union> (ik\<^sub>e\<^sub>s\<^sub>t \<A>') \<subseteq>
          (\<Union>(ik\<^sub>s\<^sub>t ` dual\<^sub>s\<^sub>t ` \<S>)) \<union> (ik\<^sub>e\<^sub>s\<^sub>t \<A>)" (is ?A)
         "(\<Union>(assignment_rhs\<^sub>s\<^sub>t ` \<S>')) \<union> (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>') \<subseteq>
          (\<Union>(assignment_rhs\<^sub>s\<^sub>t ` \<S>)) \<union> (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>)" (is ?B)
 proof -
   have 1: "t' \<in> (\<Union>(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t ` \<S>)) \<union> (ik\<^sub>e\<^sub>s\<^sub>t \<A>)"
     when "t' \<in> (\<Union>(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t ` \<S>')) \<union> (ik\<^sub>e\<^sub>s\<^sub>t \<A>')"
     for t'
   proof -
     have "t' \<in> (\<Union>(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t ` \<S>')) \<union> (ik\<^sub>e\<^sub>s\<^sub>t \<A>)" using that assms ik\<^sub>e\<^sub>s\<^sub>t_append by auto
     thus ?thesis using ik\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_subset[OF assms(1)] assms(2) by auto
   qed
 
   have 2: "t'' \<in> (\<Union>(assignment_rhs\<^sub>s\<^sub>t ` \<S>)) \<union> (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>)"
     when "t'' \<in> (\<Union>(assignment_rhs\<^sub>s\<^sub>t ` \<S>')) \<union> (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>')" "a = Assign"
     for t''
   proof -
     have "t'' \<in> (\<Union>(assignment_rhs\<^sub>s\<^sub>t ` \<S>')) \<union> (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>) \<union> {t'}"
       using that assms assignment_rhs\<^sub>e\<^sub>s\<^sub>t_append by auto
     moreover have "t' \<in> \<Union>(assignment_rhs\<^sub>s\<^sub>t ` \<S>)" using assms(1) that by force
     ultimately show ?thesis using ik\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_subset[OF assms(1)] assms(2) that by auto
   qed
 
   have 3: "assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>' = assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>" (is ?C)
           "(\<Union>(assignment_rhs\<^sub>s\<^sub>t ` \<S>')) \<subseteq> (\<Union>(assignment_rhs\<^sub>s\<^sub>t ` \<S>))" (is ?D)
     when "a = Check"
   proof -
     show ?C using that assms(2,3) by (simp add: assignment_rhs\<^sub>e\<^sub>s\<^sub>t_append)
-    show ?D using assms(1,2,3) ik\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_subset(2) by auto 
+    show ?D using assms(1,2,3) ik\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_subset(2) by auto
   qed
 
   show ?A using 1 2 by (metis subsetI)
   show ?B using 1 2 3 by (cases a) blast+
 qed
 
 private lemma ik\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_subset_ineq:
   assumes "\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t#S \<in> \<S>"
           "\<S>' = update\<^sub>s\<^sub>t \<S> (\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t#S)"
           "\<A>' = \<A>@[Step (\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t)]"
   shows "(\<Union>(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t ` \<S>')) \<union> (ik\<^sub>e\<^sub>s\<^sub>t \<A>') \<subseteq>
           (\<Union>(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t ` \<S>)) \<union> (ik\<^sub>e\<^sub>s\<^sub>t \<A>)" (is ?A)
         "(\<Union>(assignment_rhs\<^sub>s\<^sub>t ` \<S>')) \<union> (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>') \<subseteq>
          (\<Union>(assignment_rhs\<^sub>s\<^sub>t ` \<S>)) \<union> (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>)" (is ?B)
 proof -
   { fix t' assume t'_in: "t' \<in> (\<Union>(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t ` \<S>')) \<union> (ik\<^sub>e\<^sub>s\<^sub>t \<A>')"
     hence "t' \<in> (\<Union>(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t ` \<S>')) \<union> (ik\<^sub>e\<^sub>s\<^sub>t \<A>)" using assms ik\<^sub>e\<^sub>s\<^sub>t_append by auto
     hence "t' \<in> (\<Union>(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t ` \<S>)) \<union> (ik\<^sub>e\<^sub>s\<^sub>t \<A>)"
       using ik\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_subset[OF assms(1)] assms(2) by auto
   }
   moreover
   { fix t' assume t'_in: "t' \<in> (\<Union>(assignment_rhs\<^sub>s\<^sub>t ` \<S>')) \<union> (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>')"
     hence "t' \<in> (\<Union>(assignment_rhs\<^sub>s\<^sub>t ` \<S>')) \<union> (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>)"
       using assms assignment_rhs\<^sub>e\<^sub>s\<^sub>t_append by auto
     hence "t' \<in> (\<Union>(assignment_rhs\<^sub>s\<^sub>t ` \<S>)) \<union> (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>)"
       using ik\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_subset[OF assms(1)] assms(2) by auto
   }
   ultimately show ?A ?B by (metis subsetI)+
 qed
 
 
 subsubsection \<open>Transition Systems Definitions\<close>
 inductive pts_symbolic::
   "(('fun,'var) strands \<times> ('fun,'var) strand) \<Rightarrow>
    (('fun,'var) strands \<times> ('fun,'var) strand) \<Rightarrow> bool"
 (infix "\<Rightarrow>\<^sup>\<bullet>" 50) where
   Nil[simp]:        "[] \<in> \<S> \<Longrightarrow> (\<S>,\<A>) \<Rightarrow>\<^sup>\<bullet> (update\<^sub>s\<^sub>t \<S> [],\<A>)"
 | Send[simp]:       "send\<langle>t\<rangle>\<^sub>s\<^sub>t#S \<in> \<S> \<Longrightarrow> (\<S>,\<A>) \<Rightarrow>\<^sup>\<bullet> (update\<^sub>s\<^sub>t \<S> (send\<langle>t\<rangle>\<^sub>s\<^sub>t#S),\<A>@[receive\<langle>t\<rangle>\<^sub>s\<^sub>t])"
 | Receive[simp]:    "receive\<langle>t\<rangle>\<^sub>s\<^sub>t#S \<in> \<S> \<Longrightarrow> (\<S>,\<A>) \<Rightarrow>\<^sup>\<bullet> (update\<^sub>s\<^sub>t \<S> (receive\<langle>t\<rangle>\<^sub>s\<^sub>t#S),\<A>@[send\<langle>t\<rangle>\<^sub>s\<^sub>t])"
 | Equality[simp]:   "\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t#S \<in> \<S> \<Longrightarrow> (\<S>,\<A>) \<Rightarrow>\<^sup>\<bullet> (update\<^sub>s\<^sub>t \<S> (\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t#S),\<A>@[\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t])"
 | Inequality[simp]: "\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t#S \<in> \<S> \<Longrightarrow> (\<S>,\<A>) \<Rightarrow>\<^sup>\<bullet> (update\<^sub>s\<^sub>t \<S> (\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t#S),\<A>@[\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t])"
 
 private inductive pts_symbolic_c::
   "(('fun,'var) strands \<times> ('fun,'var) extstrand) \<Rightarrow>
    (('fun,'var) strands \<times> ('fun,'var) extstrand) \<Rightarrow> bool"
 (infix "\<Rightarrow>\<^sup>\<bullet>\<^sub>c" 50) where
   Nil[simp]:        "[] \<in> \<S> \<Longrightarrow> (\<S>,\<A>) \<Rightarrow>\<^sup>\<bullet>\<^sub>c (update\<^sub>s\<^sub>t \<S> [],\<A>)"
 | Send[simp]:       "send\<langle>t\<rangle>\<^sub>s\<^sub>t#S \<in> \<S> \<Longrightarrow> (\<S>,\<A>) \<Rightarrow>\<^sup>\<bullet>\<^sub>c (update\<^sub>s\<^sub>t \<S> (send\<langle>t\<rangle>\<^sub>s\<^sub>t#S),\<A>@[Step (receive\<langle>t\<rangle>\<^sub>s\<^sub>t)])"
 | Receive[simp]:    "receive\<langle>t\<rangle>\<^sub>s\<^sub>t#S \<in> \<S> \<Longrightarrow> (\<S>,\<A>) \<Rightarrow>\<^sup>\<bullet>\<^sub>c (update\<^sub>s\<^sub>t \<S> (receive\<langle>t\<rangle>\<^sub>s\<^sub>t#S),\<A>@[Step (send\<langle>t\<rangle>\<^sub>s\<^sub>t)])"
 | Equality[simp]:   "\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t#S \<in> \<S> \<Longrightarrow> (\<S>,\<A>) \<Rightarrow>\<^sup>\<bullet>\<^sub>c (update\<^sub>s\<^sub>t \<S> (\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t#S),\<A>@[Step (\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t)])"
 | Inequality[simp]: "\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t#S \<in> \<S> \<Longrightarrow> (\<S>,\<A>) \<Rightarrow>\<^sup>\<bullet>\<^sub>c (update\<^sub>s\<^sub>t \<S> (\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t#S),\<A>@[Step (\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t)])"
 | Decompose[simp]:  "Fun f T \<in> subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t \<A> \<union> assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>)
                      \<Longrightarrow> (\<S>,\<A>) \<Rightarrow>\<^sup>\<bullet>\<^sub>c (\<S>,\<A>@[Decomp (Fun f T)])"
 
 abbreviation pts_symbolic_rtrancl (infix "\<Rightarrow>\<^sup>\<bullet>\<^sup>*" 50) where "a \<Rightarrow>\<^sup>\<bullet>\<^sup>* b \<equiv> pts_symbolic\<^sup>*\<^sup>* a b"
 private abbreviation pts_symbolic_c_rtrancl (infix "\<Rightarrow>\<^sup>\<bullet>\<^sub>c\<^sup>*" 50) where "a \<Rightarrow>\<^sup>\<bullet>\<^sub>c\<^sup>* b \<equiv> pts_symbolic_c\<^sup>*\<^sup>* a b"
 
 lemma pts_symbolic_induct[consumes 1, case_names Nil Send Receive Equality Inequality]:
   assumes "(\<S>,\<A>) \<Rightarrow>\<^sup>\<bullet> (\<S>',\<A>')"
   and "\<lbrakk>[] \<in> \<S>; \<S>' = update\<^sub>s\<^sub>t \<S> []; \<A>' = \<A>\<rbrakk> \<Longrightarrow> P"
   and "\<And>t S. \<lbrakk>send\<langle>t\<rangle>\<^sub>s\<^sub>t#S \<in> \<S>; \<S>' = update\<^sub>s\<^sub>t \<S> (send\<langle>t\<rangle>\<^sub>s\<^sub>t#S); \<A>' = \<A>@[receive\<langle>t\<rangle>\<^sub>s\<^sub>t]\<rbrakk> \<Longrightarrow> P"
   and "\<And>t S. \<lbrakk>receive\<langle>t\<rangle>\<^sub>s\<^sub>t#S \<in> \<S>; \<S>' = update\<^sub>s\<^sub>t \<S> (receive\<langle>t\<rangle>\<^sub>s\<^sub>t#S); \<A>' = \<A>@[send\<langle>t\<rangle>\<^sub>s\<^sub>t]\<rbrakk> \<Longrightarrow> P"
   and "\<And>a t t' S. \<lbrakk>\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t#S \<in> \<S>; \<S>' = update\<^sub>s\<^sub>t \<S> (\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t#S); \<A>' = \<A>@[\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t]\<rbrakk> \<Longrightarrow> P"
   and "\<And>X F S. \<lbrakk>\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t#S \<in> \<S>; \<S>' = update\<^sub>s\<^sub>t \<S> (\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t#S); \<A>' = \<A>@[\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t]\<rbrakk> \<Longrightarrow> P"
   shows "P"
 apply (rule pts_symbolic.cases[OF assms(1)])
 using assms(2,3,4,5,6) by simp_all
 
 private lemma pts_symbolic_c_induct[consumes 1, case_names Nil Send Receive Equality Inequality Decompose]:
   assumes "(\<S>,\<A>) \<Rightarrow>\<^sup>\<bullet>\<^sub>c (\<S>',\<A>')"
   and "\<lbrakk>[] \<in> \<S>; \<S>' = update\<^sub>s\<^sub>t \<S> []; \<A>' = \<A>\<rbrakk> \<Longrightarrow> P"
   and "\<And>t S. \<lbrakk>send\<langle>t\<rangle>\<^sub>s\<^sub>t#S \<in> \<S>; \<S>' = update\<^sub>s\<^sub>t \<S> (send\<langle>t\<rangle>\<^sub>s\<^sub>t#S); \<A>' = \<A>@[Step (receive\<langle>t\<rangle>\<^sub>s\<^sub>t)]\<rbrakk> \<Longrightarrow> P"
   and "\<And>t S. \<lbrakk>receive\<langle>t\<rangle>\<^sub>s\<^sub>t#S \<in> \<S>; \<S>' = update\<^sub>s\<^sub>t \<S> (receive\<langle>t\<rangle>\<^sub>s\<^sub>t#S); \<A>' = \<A>@[Step (send\<langle>t\<rangle>\<^sub>s\<^sub>t)]\<rbrakk> \<Longrightarrow> P"
   and "\<And>a t t' S. \<lbrakk>\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t#S \<in> \<S>; \<S>' = update\<^sub>s\<^sub>t \<S> (\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t#S); \<A>' = \<A>@[Step (\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t)]\<rbrakk> \<Longrightarrow> P"
   and "\<And>X F S. \<lbrakk>\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t#S \<in> \<S>; \<S>' = update\<^sub>s\<^sub>t \<S> (\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t#S); \<A>' = \<A>@[Step (\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t)]\<rbrakk> \<Longrightarrow> P"
   and "\<And>f T. \<lbrakk>Fun f T \<in> subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t \<A> \<union> assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>); \<S>' = \<S>; \<A>' = \<A>@[Decomp (Fun f T)]\<rbrakk> \<Longrightarrow> P"
   shows "P"
 apply (rule pts_symbolic_c.cases[OF assms(1)])
 using assms(2,3,4,5,6,7) by simp_all
 
 private lemma pts_symbolic_c_preserves_wf_prot:
   assumes "(\<S>,\<A>) \<Rightarrow>\<^sup>\<bullet>\<^sub>c\<^sup>* (\<S>',\<A>')" "wf\<^sub>s\<^sub>t\<^sub>s' \<S> \<A>"
   shows "wf\<^sub>s\<^sub>t\<^sub>s' \<S>' \<A>'"
 using assms
 proof (induction rule: rtranclp_induct2)
   case (step \<S>1 \<A>1 \<S>2 \<A>2)
   from step.hyps(2) step.IH[OF step.prems] show ?case
   proof (induction rule: pts_symbolic_c_induct)
     case Decompose
     hence "fv\<^sub>e\<^sub>s\<^sub>t \<A>2 = fv\<^sub>e\<^sub>s\<^sub>t \<A>1" "bvars\<^sub>e\<^sub>s\<^sub>t \<A>2 = bvars\<^sub>e\<^sub>s\<^sub>t \<A>1"
       using bvars_decomp ik_assignment_rhs_decomp_fv by metis+
     thus ?case using Decompose unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def
       by (metis wf_vars_mono wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t_split(2))
   qed (metis wf\<^sub>s\<^sub>t\<^sub>s'_update\<^sub>s\<^sub>t_nil, metis wf\<^sub>s\<^sub>t\<^sub>s'_update\<^sub>s\<^sub>t_snd,
        metis wf\<^sub>s\<^sub>t\<^sub>s'_update\<^sub>s\<^sub>t_rcv, metis wf\<^sub>s\<^sub>t\<^sub>s'_update\<^sub>s\<^sub>t_eq,
        metis wf\<^sub>s\<^sub>t\<^sub>s'_update\<^sub>s\<^sub>t_ineq)
 qed metis
 
 private lemma pts_symbolic_c_preserves_wf_is:
   assumes "(\<S>,\<A>) \<Rightarrow>\<^sup>\<bullet>\<^sub>c\<^sup>* (\<S>',\<A>')" "wf\<^sub>s\<^sub>t\<^sub>s' \<S> \<A>" "wf\<^sub>s\<^sub>t V (to_st \<A>)"
   shows "wf\<^sub>s\<^sub>t V (to_st \<A>')"
 using assms
 proof (induction rule: rtranclp_induct2)
   case (step \<S>1 \<A>1 \<S>2 \<A>2)
   hence "(\<S>, \<A>) \<Rightarrow>\<^sup>\<bullet>\<^sub>c\<^sup>* (\<S>2, \<A>2)" by auto
   hence *: "wf\<^sub>s\<^sub>t\<^sub>s' \<S>1 \<A>1" "wf\<^sub>s\<^sub>t\<^sub>s' \<S>2 \<A>2"
     using pts_symbolic_c_preserves_wf_prot[OF _ step.prems(1)] step.hyps(1)
     by auto
 
   from step.hyps(2) step.IH[OF step.prems] show ?case
   proof (induction rule: pts_symbolic_c_induct)
     case Nil thus ?case by auto
   next
     case (Send t S)
     hence "wf\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t \<A>1) (receive\<langle>t\<rangle>\<^sub>s\<^sub>t#(dual\<^sub>s\<^sub>t S))"
       using *(1) unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by fastforce
     hence "fv t \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t (to_st \<A>1) \<union> V"
       using wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t_eq_wfrestrictedvars\<^sub>s\<^sub>t by auto
     thus ?case using Send wf_rcv_append''' to_st_append by simp
   next
     case (Receive t) thus ?case using wf_snd_append to_st_append by simp
   next
     case (Equality a t t' S)
     hence "wf\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t \<A>1) (\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t#(dual\<^sub>s\<^sub>t S))"
       using *(1) unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by fastforce
     hence "fv t' \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t (to_st \<A>1) \<union> V" when "a = Assign"
       using wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t_eq_wfrestrictedvars\<^sub>s\<^sub>t that by auto
     thus ?case using Equality wf_eq_append''' to_st_append by (cases a) auto
   next
     case (Inequality t t' S) thus ?case using wf_ineq_append'' to_st_append by simp
   next
     case (Decompose f T)
     hence "fv (Fun f T) \<subseteq> wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t \<A>1"
       by (metis fv_subterms_set fv_subset subset_trans
                 ik\<^sub>s\<^sub>t_assignment_rhs\<^sub>s\<^sub>t_wfrestrictedvars_subset)
     hence "vars\<^sub>s\<^sub>t (decomp (Fun f T)) \<subseteq> wfrestrictedvars\<^sub>s\<^sub>t (to_st \<A>1) \<union> V"
       using decomp_vars[of "Fun f T"] wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t_eq_wfrestrictedvars\<^sub>s\<^sub>t[of \<A>1] by auto
     thus ?case
       using to_st_append[of \<A>1 "[Decomp (Fun f T)]"]
             wf_append_suffix[OF Decompose.prems] Decompose.hyps(3)
       by (metis append_Nil2 decomp_vars(1,2) to_st.simps(1,3))
   qed
 qed metis
 
 private lemma pts_symbolic_c_preserves_tfr\<^sub>s\<^sub>e\<^sub>t:
   assumes "(\<S>,\<A>) \<Rightarrow>\<^sup>\<bullet>\<^sub>c\<^sup>* (\<S>',\<A>')"
     and "tfr\<^sub>s\<^sub>e\<^sub>t ((\<Union>(trms\<^sub>s\<^sub>t ` \<S>)) \<union> (trms\<^sub>e\<^sub>s\<^sub>t \<A>))"
     and "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s ((\<Union>(trms\<^sub>s\<^sub>t ` \<S>)) \<union> (trms\<^sub>e\<^sub>s\<^sub>t \<A>))"
   shows "tfr\<^sub>s\<^sub>e\<^sub>t ((\<Union>(trms\<^sub>s\<^sub>t ` \<S>')) \<union> (trms\<^sub>e\<^sub>s\<^sub>t \<A>')) \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s ((\<Union>(trms\<^sub>s\<^sub>t ` \<S>')) \<union> (trms\<^sub>e\<^sub>s\<^sub>t \<A>'))"
 using assms
 proof (induction rule: rtranclp_induct2)
   case (step \<S>1 \<A>1 \<S>2 \<A>2)
   from step.hyps(2) step.IH[OF step.prems] show ?case
   proof (induction rule: pts_symbolic_c_induct)
     case Nil
     hence "\<Union>(trms\<^sub>s\<^sub>t ` \<S>1) = \<Union>(trms\<^sub>s\<^sub>t ` \<S>2)" by force
     thus ?case using Nil by metis
   next
     case (Decompose f T)
     obtain t where t: "t \<in> ik\<^sub>e\<^sub>s\<^sub>t \<A>1 \<union> assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>1" "Fun f T \<sqsubseteq> t"
       using Decompose.hyps(1) by auto
     have t_wf: "wf\<^sub>t\<^sub>r\<^sub>m t"
       using Decompose.prems wf_trm_subterm[of _ t]
             trms\<^sub>e\<^sub>s\<^sub>t_ik_assignment_rhsI[OF t(1)]
       unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def
       by (metis UN_E Un_iff)
     have "t \<in> subterms\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>e\<^sub>s\<^sub>t \<A>1)" using trms\<^sub>e\<^sub>s\<^sub>t_ik_assignment_rhsI t by auto
     hence "Fun f T \<in> SMP (trms\<^sub>e\<^sub>s\<^sub>t \<A>1)"
-      by (metis (no_types) SMP.MP SMP.Subterm UN_E t(2)) 
+      by (metis (no_types) SMP.MP SMP.Subterm UN_E t(2))
     hence "{Fun f T} \<subseteq> SMP (trms\<^sub>e\<^sub>s\<^sub>t \<A>1)" using SMP.Subterm[of "Fun f T"] by auto
     moreover have "trms\<^sub>e\<^sub>s\<^sub>t \<A>2 = insert (Fun f T) (trms\<^sub>e\<^sub>s\<^sub>t \<A>1)"
       using Decompose.hyps(3) by auto
     ultimately have *: "SMP (trms\<^sub>e\<^sub>s\<^sub>t \<A>1) = SMP (trms\<^sub>e\<^sub>s\<^sub>t \<A>2)"
       using SMP_subset_union_eq[of "{Fun f T}"]
       by (simp add: Un_commute)
     hence "SMP ((\<Union>(trms\<^sub>s\<^sub>t ` \<S>1)) \<union> (trms\<^sub>e\<^sub>s\<^sub>t \<A>1)) = SMP ((\<Union>(trms\<^sub>s\<^sub>t ` \<S>2)) \<union> (trms\<^sub>e\<^sub>s\<^sub>t \<A>2))"
       using Decompose.hyps(2) SMP_union by auto
     moreover have "\<forall>t \<in> trms\<^sub>e\<^sub>s\<^sub>t \<A>1. wf\<^sub>t\<^sub>r\<^sub>m t" "wf\<^sub>t\<^sub>r\<^sub>m (Fun f T)"
       using Decompose.prems wf_trm_subterm t(2) t_wf unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def by auto
-    hence "\<forall>t \<in> trms\<^sub>e\<^sub>s\<^sub>t \<A>2. wf\<^sub>t\<^sub>r\<^sub>m t" by (metis * SMP.MP SMP_wf_trm) 
+    hence "\<forall>t \<in> trms\<^sub>e\<^sub>s\<^sub>t \<A>2. wf\<^sub>t\<^sub>r\<^sub>m t" by (metis * SMP.MP SMP_wf_trm)
     hence "\<forall>t \<in> (\<Union>(trms\<^sub>s\<^sub>t ` \<S>2)) \<union> (trms\<^sub>e\<^sub>s\<^sub>t \<A>2). wf\<^sub>t\<^sub>r\<^sub>m t"
       using Decompose.prems Decompose.hyps(2) unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def by force
-    ultimately show ?thesis using Decompose.prems unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def by presburger 
+    ultimately show ?thesis using Decompose.prems unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def by presburger
   qed (metis trms\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_eq_snd, metis trms\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_eq_rcv,
        metis trms\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_eq_eq, metis trms\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_eq_ineq)
 qed metis
 
 private lemma pts_symbolic_c_preserves_tfr\<^sub>s\<^sub>t\<^sub>p:
   assumes "(\<S>,\<A>) \<Rightarrow>\<^sup>\<bullet>\<^sub>c\<^sup>* (\<S>',\<A>')" "\<forall>S \<in> \<S> \<union> {to_st \<A>}. list_all tfr\<^sub>s\<^sub>t\<^sub>p S"
   shows "\<forall>S \<in> \<S>' \<union> {to_st \<A>'}. list_all tfr\<^sub>s\<^sub>t\<^sub>p S"
 using assms
 proof (induction rule: rtranclp_induct2)
   case (step \<S>1 \<A>1 \<S>2 \<A>2)
   from step.hyps(2) step.IH[OF step.prems] show ?case
   proof (induction rule: pts_symbolic_c_induct)
     case Nil
     have 1: "\<forall>S \<in> {to_st \<A>2}. list_all tfr\<^sub>s\<^sub>t\<^sub>p S" using Nil by simp
     have 2: "\<S>2 = \<S>1 - {[]}" "\<forall>S \<in> \<S>1. list_all tfr\<^sub>s\<^sub>t\<^sub>p S"  using Nil by simp_all
     have "\<forall>S \<in> \<S>2. list_all tfr\<^sub>s\<^sub>t\<^sub>p S"
     proof
       fix S assume "S \<in> \<S>2"
       hence "S \<in> \<S>1" using 2(1) by simp
       thus "list_all tfr\<^sub>s\<^sub>t\<^sub>p S" using 2(2) by simp
     qed
     thus ?case using 1 by auto
   next
     case (Send t S)
     have 1: "\<forall>S \<in> {to_st \<A>2}. list_all tfr\<^sub>s\<^sub>t\<^sub>p S" using Send by (simp add: to_st_append)
     have 2: "\<S>2 = insert S (\<S>1 - {send\<langle>t\<rangle>\<^sub>s\<^sub>t#S})" "\<forall>S \<in> \<S>1. list_all tfr\<^sub>s\<^sub>t\<^sub>p S"  using Send by simp_all
     have 3: "\<forall>S \<in> \<S>2. list_all tfr\<^sub>s\<^sub>t\<^sub>p S"
     proof
       fix S' assume "S' \<in> \<S>2"
       hence "S' \<in> \<S>1 \<or> S' = S" using 2(1) by auto
       moreover have "list_all tfr\<^sub>s\<^sub>t\<^sub>p S" using Send.hyps 2(2) by auto
       ultimately show "list_all tfr\<^sub>s\<^sub>t\<^sub>p S'" using 2(2) by blast
     qed
     thus ?case using 1 by auto
   next
     case (Receive t S)
     have 1: "\<forall>S \<in> {to_st \<A>2}. list_all tfr\<^sub>s\<^sub>t\<^sub>p S" using Receive by (simp add: to_st_append)
     have 2: "\<S>2 = insert S (\<S>1 - {receive\<langle>t\<rangle>\<^sub>s\<^sub>t#S})" "\<forall>S \<in> \<S>1. list_all tfr\<^sub>s\<^sub>t\<^sub>p S"
       using Receive by simp_all
     have 3: "\<forall>S \<in> \<S>2. list_all tfr\<^sub>s\<^sub>t\<^sub>p S"
     proof
       fix S' assume "S' \<in> \<S>2"
       hence "S' \<in> \<S>1 \<or> S' = S" using 2(1) by auto
       moreover have "list_all tfr\<^sub>s\<^sub>t\<^sub>p S" using Receive.hyps 2(2) by auto
       ultimately show "list_all tfr\<^sub>s\<^sub>t\<^sub>p S'" using 2(2) by blast
     qed
     show ?case using 1 3 by auto
   next
     case (Equality a t t' S)
     have 1: "to_st \<A>2 = to_st \<A>1@[\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t]" "list_all tfr\<^sub>s\<^sub>t\<^sub>p (to_st \<A>1)"
       using Equality by (simp_all add: to_st_append)
     have 2: "list_all tfr\<^sub>s\<^sub>t\<^sub>p [\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t]" using Equality by fastforce
     have 3: "list_all tfr\<^sub>s\<^sub>t\<^sub>p (to_st \<A>2)"
       using tfr_stp_all_append[of "to_st \<A>1" "[\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t]"] 1 2 by metis
     hence 4: "\<forall>S \<in> {to_st \<A>2}. list_all tfr\<^sub>s\<^sub>t\<^sub>p S" using Equality by simp
     have 5: "\<S>2 = insert S (\<S>1 - {\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t#S})" "\<forall>S \<in> \<S>1. list_all tfr\<^sub>s\<^sub>t\<^sub>p S"
       using Equality by simp_all
-    have 6: "\<forall>S \<in> \<S>2. list_all tfr\<^sub>s\<^sub>t\<^sub>p S" 
+    have 6: "\<forall>S \<in> \<S>2. list_all tfr\<^sub>s\<^sub>t\<^sub>p S"
     proof
       fix S' assume "S' \<in> \<S>2"
       hence "S' \<in> \<S>1 \<or> S' = S" using 5(1) by auto
       moreover have "list_all tfr\<^sub>s\<^sub>t\<^sub>p S" using Equality.hyps 5(2) by auto
       ultimately show "list_all tfr\<^sub>s\<^sub>t\<^sub>p S'" using 5(2) by blast
     qed
     thus ?case using 4 by auto
   next
     case (Inequality X F S)
     have 1: "to_st \<A>2 = to_st \<A>1@[\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t]" "list_all tfr\<^sub>s\<^sub>t\<^sub>p (to_st \<A>1)"
       using Inequality by (simp_all add: to_st_append)
     have "list_all tfr\<^sub>s\<^sub>t\<^sub>p (\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t#S)" using Inequality(1,4) by blast
     hence 2: "list_all tfr\<^sub>s\<^sub>t\<^sub>p [\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t]" by simp
     have 3: "list_all tfr\<^sub>s\<^sub>t\<^sub>p (to_st \<A>2)"
       using tfr_stp_all_append[of "to_st \<A>1" "[\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t]"] 1 2 by metis
     hence 4: "\<forall>S \<in> {to_st \<A>2}. list_all tfr\<^sub>s\<^sub>t\<^sub>p S" using Inequality by simp
     have 5: "\<S>2 = insert S (\<S>1 - {\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t#S})" "\<forall>S \<in> \<S>1. list_all tfr\<^sub>s\<^sub>t\<^sub>p S"
       using Inequality by simp_all
     have 6: "\<forall>S \<in> \<S>2. list_all tfr\<^sub>s\<^sub>t\<^sub>p S"
     proof
       fix S' assume "S' \<in> \<S>2"
       hence "S' \<in> \<S>1 \<or> S' = S" using 5(1) by auto
       moreover have "list_all tfr\<^sub>s\<^sub>t\<^sub>p S" using Inequality.hyps 5(2) by auto
       ultimately show "list_all tfr\<^sub>s\<^sub>t\<^sub>p S'" using 5(2) by blast
     qed
     thus ?case using 4 by auto
   next
     case (Decompose f T)
     hence 1: "\<forall>S \<in> \<S>2. list_all tfr\<^sub>s\<^sub>t\<^sub>p S" by blast
     have 2: "list_all tfr\<^sub>s\<^sub>t\<^sub>p (to_st \<A>1)" "list_all tfr\<^sub>s\<^sub>t\<^sub>p (to_st [Decomp (Fun f T)])"
       using Decompose.prems decomp_tfr\<^sub>s\<^sub>t\<^sub>p by auto
     hence "list_all tfr\<^sub>s\<^sub>t\<^sub>p (to_st \<A>1@to_st [Decomp (Fun f T)])" by auto
     hence "list_all tfr\<^sub>s\<^sub>t\<^sub>p (to_st \<A>2)"
       using Decompose.hyps(3) to_st_append[of \<A>1 "[Decomp (Fun f T)]"]
       by auto
     thus ?case using 1 by blast
   qed
 qed
 
 private lemma pts_symbolic_c_preserves_well_analyzed:
   assumes "(\<S>,\<A>) \<Rightarrow>\<^sup>\<bullet>\<^sub>c\<^sup>* (\<S>',\<A>')" "well_analyzed \<A>"
   shows "well_analyzed \<A>'"
 using assms
 proof (induction rule: rtranclp_induct2)
   case (step \<S>1 \<A>1 \<S>2 \<A>2)
   from step.hyps(2) step.IH[OF step.prems] show ?case
   proof (induction rule: pts_symbolic_c_induct)
     case Receive thus ?case by (metis well_analyzed_singleton(1) well_analyzed_append)
   next
     case Send thus ?case by (metis well_analyzed_singleton(2) well_analyzed_append)
   next
     case Equality thus ?case by (metis well_analyzed_singleton(3) well_analyzed_append)
   next
     case Inequality thus ?case by (metis well_analyzed_singleton(4) well_analyzed_append)
   next
     case (Decompose f T)
     hence "Fun f T \<in> subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t \<A>1 \<union> assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>1) - (Var`\<V>)" by auto
     thus ?case by (metis well_analyzed.Decomp Decompose.prems Decompose.hyps(3))
   qed simp
 qed metis
 
 private lemma pts_symbolic_c_preserves_Ana_invar_subst:
   assumes "(\<S>,\<A>) \<Rightarrow>\<^sup>\<bullet>\<^sub>c\<^sup>* (\<S>',\<A>')"
     and "Ana_invar_subst (
           (\<Union>(ik\<^sub>s\<^sub>t ` dual\<^sub>s\<^sub>t ` \<S>) \<union> (ik\<^sub>e\<^sub>s\<^sub>t \<A>)) \<union>
           (\<Union>(assignment_rhs\<^sub>s\<^sub>t ` \<S>) \<union> (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>)))"
   shows "Ana_invar_subst (
           (\<Union>(ik\<^sub>s\<^sub>t ` dual\<^sub>s\<^sub>t ` \<S>') \<union> (ik\<^sub>e\<^sub>s\<^sub>t \<A>')) \<union>
           (\<Union>(assignment_rhs\<^sub>s\<^sub>t ` \<S>') \<union> (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>')))"
 using assms
 proof (induction rule: rtranclp_induct2)
   case (step \<S>1 \<A>1 \<S>2 \<A>2)
   from step.hyps(2) step.IH[OF step.prems] show ?case
   proof (induction rule: pts_symbolic_c_induct)
     case Nil
     hence "\<Union>(ik\<^sub>s\<^sub>t ` dual\<^sub>s\<^sub>t ` \<S>1) = \<Union>(ik\<^sub>s\<^sub>t ` dual\<^sub>s\<^sub>t ` \<S>2)"
           "\<Union>(assignment_rhs\<^sub>s\<^sub>t ` \<S>1) = \<Union>(assignment_rhs\<^sub>s\<^sub>t ` \<S>2)"
       by force+
     thus ?case using Nil by metis
-  next 
+  next
     case Send show ?case
       using ik\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_subset_snd[OF Send.hyps]
             Ana_invar_subst_subset[OF Send.prems]
       by (metis Un_mono)
   next
     case Receive show ?case
       using ik\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_subset_rcv[OF Receive.hyps]
             Ana_invar_subst_subset[OF Receive.prems]
       by (metis Un_mono)
   next
     case Equality show ?case
       using ik\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_subset_eq[OF Equality.hyps]
             Ana_invar_subst_subset[OF Equality.prems]
       by (metis Un_mono)
   next
     case Inequality show ?case
       using ik\<^sub>s\<^sub>t_update\<^sub>s\<^sub>t_subset_ineq[OF Inequality.hyps]
             Ana_invar_subst_subset[OF Inequality.prems]
       by (metis Un_mono)
   next
     case (Decompose f T)
     let ?X = "\<Union>(assignment_rhs\<^sub>s\<^sub>t`\<S>2) \<union> assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>2"
     let ?Y = "\<Union>(assignment_rhs\<^sub>s\<^sub>t`\<S>1) \<union> assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>1"
     obtain K M where Ana: "Ana (Fun f T) = (K,M)" by moura
     hence *: "ik\<^sub>e\<^sub>s\<^sub>t \<A>2 = ik\<^sub>e\<^sub>s\<^sub>t \<A>1 \<union> set M" "assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>2 = assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>1"
       using ik\<^sub>e\<^sub>s\<^sub>t_append assignment_rhs\<^sub>e\<^sub>s\<^sub>t_append decomp_ik
             decomp_assignment_rhs_empty Decompose.hyps(3)
       by auto
     { fix g S assume "Fun g S \<in> subterms\<^sub>s\<^sub>e\<^sub>t (\<Union>(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t`\<S>2) \<union> ik\<^sub>e\<^sub>s\<^sub>t \<A>2 \<union> ?X)"
       hence "Fun g S \<in> subterms\<^sub>s\<^sub>e\<^sub>t (\<Union>(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t ` \<S>1) \<union> ik\<^sub>e\<^sub>s\<^sub>t \<A>1 \<union> set M \<union> ?X)"
         using * Decompose.hyps(2) by auto
       hence "Fun g S \<in> subterms\<^sub>s\<^sub>e\<^sub>t (\<Union>(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t ` \<S>1))
             \<or> Fun g S \<in> subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t \<A>1)
             \<or> Fun g S \<in> subterms\<^sub>s\<^sub>e\<^sub>t (set M)
             \<or> Fun g S \<in> subterms\<^sub>s\<^sub>e\<^sub>t (\<Union>(assignment_rhs\<^sub>s\<^sub>t`\<S>1))
             \<or> Fun g S \<in> subterms\<^sub>s\<^sub>e\<^sub>t (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>1)"
         using Decompose * Ana_fun_subterm[OF Ana] by auto
       moreover have "Fun f T \<in> subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t \<A>1 \<union> assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>1)"
-        using trms\<^sub>e\<^sub>s\<^sub>t_ik_subtermsI Decompose.hyps(1) by auto 
+        using trms\<^sub>e\<^sub>s\<^sub>t_ik_subtermsI Decompose.hyps(1) by auto
       hence "subterms (Fun f T) \<subseteq> subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t \<A>1 \<union> assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>1)"
         by (metis in_subterms_subset_Union)
       hence "subterms\<^sub>s\<^sub>e\<^sub>t (set M) \<subseteq> subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t \<A>1 \<union> assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>1)"
         by (meson Un_upper2 Ana_subterm[OF Ana] subterms_subset_set psubsetE subset_trans)
       ultimately have "Fun g S \<in> subterms\<^sub>s\<^sub>e\<^sub>t (\<Union>(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t ` \<S>1) \<union> ik\<^sub>e\<^sub>s\<^sub>t \<A>1 \<union> ?Y)"
         by auto
     }
     thus ?case using Decompose unfolding Ana_invar_subst_def by metis
   qed
 qed
 
 private lemma pts_symbolic_c_preserves_constr_disj_vars:
   assumes "(\<S>,\<A>) \<Rightarrow>\<^sup>\<bullet>\<^sub>c\<^sup>* (\<S>',\<A>')" "wf\<^sub>s\<^sub>t\<^sub>s' \<S> \<A>" "fv\<^sub>e\<^sub>s\<^sub>t \<A> \<inter> bvars\<^sub>e\<^sub>s\<^sub>t \<A> = {}"
   shows "fv\<^sub>e\<^sub>s\<^sub>t \<A>' \<inter> bvars\<^sub>e\<^sub>s\<^sub>t \<A>' = {}"
 using assms
 proof (induction rule: rtranclp_induct2)
   case (step \<S>1 \<A>1 \<S>2 \<A>2)
   have *: "\<And>S. S \<in> \<S>1 \<Longrightarrow> fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>e\<^sub>s\<^sub>t \<A>1 = {}" "\<And>S. S \<in> \<S>1 \<Longrightarrow> fv\<^sub>e\<^sub>s\<^sub>t \<A>1 \<inter> bvars\<^sub>s\<^sub>t S = {}"
     using pts_symbolic_c_preserves_wf_prot[OF step.hyps(1) step.prems(1)]
     unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def by auto
   from step.hyps(2) step.IH[OF step.prems]
   show ?case
   proof (induction rule: pts_symbolic_c_induct)
     case Nil thus ?case by auto
-  next 
+  next
     case (Send t S)
     hence "fv\<^sub>e\<^sub>s\<^sub>t \<A>2 = fv\<^sub>e\<^sub>s\<^sub>t \<A>1 \<union> fv t" "bvars\<^sub>e\<^sub>s\<^sub>t \<A>2 = bvars\<^sub>e\<^sub>s\<^sub>t \<A>1"
           "fv\<^sub>s\<^sub>t (send\<langle>t\<rangle>\<^sub>s\<^sub>t#S) = fv t \<union> fv\<^sub>s\<^sub>t S"
       using fv\<^sub>e\<^sub>s\<^sub>t_append bvars\<^sub>e\<^sub>s\<^sub>t_append by simp+
     thus ?case using *(1)[OF Send(1)] Send(4) by auto
   next
     case (Receive t S)
     hence "fv\<^sub>e\<^sub>s\<^sub>t \<A>2 = fv\<^sub>e\<^sub>s\<^sub>t \<A>1 \<union> fv t" "bvars\<^sub>e\<^sub>s\<^sub>t \<A>2 = bvars\<^sub>e\<^sub>s\<^sub>t \<A>1"
           "fv\<^sub>s\<^sub>t (receive\<langle>t\<rangle>\<^sub>s\<^sub>t#S) = fv t \<union> fv\<^sub>s\<^sub>t S"
       using fv\<^sub>e\<^sub>s\<^sub>t_append bvars\<^sub>e\<^sub>s\<^sub>t_append by simp+
     thus ?case using *(1)[OF Receive(1)] Receive(4) by auto
   next
     case (Equality a t t' S)
     hence "fv\<^sub>e\<^sub>s\<^sub>t \<A>2 = fv\<^sub>e\<^sub>s\<^sub>t \<A>1 \<union> fv t \<union> fv t'" "bvars\<^sub>e\<^sub>s\<^sub>t \<A>2 = bvars\<^sub>e\<^sub>s\<^sub>t \<A>1"
           "fv\<^sub>s\<^sub>t (\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t#S) = fv t \<union> fv t' \<union> fv\<^sub>s\<^sub>t S"
       using fv\<^sub>e\<^sub>s\<^sub>t_append bvars\<^sub>e\<^sub>s\<^sub>t_append by fastforce+
     thus ?case using *(1)[OF Equality(1)] Equality(4) by auto
   next
     case (Inequality X F S)
     hence "fv\<^sub>e\<^sub>s\<^sub>t \<A>2 = fv\<^sub>e\<^sub>s\<^sub>t \<A>1 \<union> (fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X)" "bvars\<^sub>e\<^sub>s\<^sub>t \<A>2 = bvars\<^sub>e\<^sub>s\<^sub>t \<A>1 \<union> set X"
           "fv\<^sub>s\<^sub>t (\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t#S) = (fv\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s F - set X) \<union> fv\<^sub>s\<^sub>t S"
       using fv\<^sub>e\<^sub>s\<^sub>t_append bvars\<^sub>e\<^sub>s\<^sub>t_append strand_vars_split(3)[of "[\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t]" S]
       by auto+
     moreover have "fv\<^sub>e\<^sub>s\<^sub>t \<A>1 \<inter> set X = {}" using *(2)[OF Inequality(1)] by auto
     ultimately show ?case using *(1)[OF Inequality(1)] Inequality(4) by auto
   next
     case (Decompose f T)
     thus ?case
       using Decompose(3,4) bvars_decomp ik_assignment_rhs_decomp_fv[OF Decompose(1)] by auto
   qed
 qed
 
 
 subsubsection \<open>Theorem: The Typing Result Lifted to the Transition System Level\<close>
 private lemma wf\<^sub>s\<^sub>t\<^sub>s'_decomp_rm:
   assumes "well_analyzed A" "wf\<^sub>s\<^sub>t\<^sub>s' S (decomp_rm\<^sub>e\<^sub>s\<^sub>t A)" shows "wf\<^sub>s\<^sub>t\<^sub>s' S A"
 unfolding wf\<^sub>s\<^sub>t\<^sub>s'_def
 proof (intro conjI)
   show "\<forall>S\<in>S. wf\<^sub>s\<^sub>t (wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t A) (dual\<^sub>s\<^sub>t S)"
     by (metis (no_types) assms(2) wf\<^sub>s\<^sub>t\<^sub>s'_def wfrestrictedvars\<^sub>e\<^sub>s\<^sub>t_decomp_rm\<^sub>e\<^sub>s\<^sub>t_subset
                 wf_vars_mono le_iff_sup)
 
   show "\<forall>Sa\<in>S. \<forall>S'\<in>S. fv\<^sub>s\<^sub>t Sa \<inter> bvars\<^sub>s\<^sub>t S' = {}" by (metis assms(2) wf\<^sub>s\<^sub>t\<^sub>s'_def)
 
   show "\<forall>S\<in>S. fv\<^sub>s\<^sub>t S \<inter> bvars\<^sub>e\<^sub>s\<^sub>t A = {}" by (metis assms(2) wf\<^sub>s\<^sub>t\<^sub>s'_def bvars_decomp_rm)
 
   show "\<forall>S\<in>S. fv\<^sub>e\<^sub>s\<^sub>t A \<inter> bvars\<^sub>s\<^sub>t S = {}" by (metis assms wf\<^sub>s\<^sub>t\<^sub>s'_def well_analyzed_decomp_rm\<^sub>e\<^sub>s\<^sub>t_fv)
 qed
 
 private lemma decomps\<^sub>e\<^sub>s\<^sub>t_pts_symbolic_c:
   assumes "D \<in> decomps\<^sub>e\<^sub>s\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t A) (assignment_rhs\<^sub>e\<^sub>s\<^sub>t A) \<I>"
   shows "(S,A) \<Rightarrow>\<^sup>\<bullet>\<^sub>c\<^sup>* (S,A@D)"
 using assms(1)
 proof (induction D rule: decomps\<^sub>e\<^sub>s\<^sub>t.induct)
   case (Decomp B f X K T)
   have "subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t A \<union> assignment_rhs\<^sub>e\<^sub>s\<^sub>t A) \<subseteq>
         subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t (A@B) \<union> assignment_rhs\<^sub>e\<^sub>s\<^sub>t (A@B))"
     using ik\<^sub>e\<^sub>s\<^sub>t_append[of A B] assignment_rhs\<^sub>e\<^sub>s\<^sub>t_append[of A B]
     by auto
   hence "Fun f X \<in> subterms\<^sub>s\<^sub>e\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t (A@B) \<union> assignment_rhs\<^sub>e\<^sub>s\<^sub>t (A@B))" using Decomp.hyps by auto
   hence "(S,A@B) \<Rightarrow>\<^sup>\<bullet>\<^sub>c (S,A@B@[Decomp (Fun f X)])"
     using pts_symbolic_c.Decompose[of f X "A@B"]
     by simp
   thus ?case
     using Decomp.IH rtrancl_into_rtrancl
           rtranclp_rtrancl_eq[of pts_symbolic_c "(S,A)" "(S,A@B)"]
     by auto
 qed simp
 
 private lemma pts_symbolic_to_pts_symbolic_c:
   assumes "(\<S>,to_st (decomp_rm\<^sub>e\<^sub>s\<^sub>t \<A>\<^sub>d)) \<Rightarrow>\<^sup>\<bullet>\<^sup>* (\<S>',\<A>')" "sem\<^sub>e\<^sub>s\<^sub>t_d {} \<I> (to_est \<A>')" "sem\<^sub>e\<^sub>s\<^sub>t_c {} \<I> \<A>\<^sub>d"
   and wf: "wf\<^sub>s\<^sub>t\<^sub>s' \<S> (decomp_rm\<^sub>e\<^sub>s\<^sub>t \<A>\<^sub>d)" "wf\<^sub>e\<^sub>s\<^sub>t {} \<A>\<^sub>d"
   and tar: "Ana_invar_subst ((\<Union>(ik\<^sub>s\<^sub>t` dual\<^sub>s\<^sub>t` \<S>) \<union> (ik\<^sub>e\<^sub>s\<^sub>t \<A>\<^sub>d))
                             \<union> (\<Union>(assignment_rhs\<^sub>s\<^sub>t` \<S>) \<union> (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>\<^sub>d)))"
   and wa: "well_analyzed \<A>\<^sub>d"
   and \<I>: "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>"
   shows "\<exists>\<A>\<^sub>d'. \<A>' = to_st (decomp_rm\<^sub>e\<^sub>s\<^sub>t \<A>\<^sub>d') \<and> (\<S>,\<A>\<^sub>d) \<Rightarrow>\<^sup>\<bullet>\<^sub>c\<^sup>* (\<S>',\<A>\<^sub>d') \<and> sem\<^sub>e\<^sub>s\<^sub>t_c {} \<I> \<A>\<^sub>d'"
 using assms(1,2)
 proof (induction rule: rtranclp_induct2)
   case refl thus ?case using assms by auto
 next
   case (step \<S>1 \<A>1 \<S>2 \<A>2)
   have "sem\<^sub>e\<^sub>s\<^sub>t_d {} \<I> (to_est \<A>1)" using step.hyps(2) step.prems
     by (induct rule: pts_symbolic_induct, metis, (metis sem\<^sub>e\<^sub>s\<^sub>t_d_split_left to_est_append)+)
   then obtain \<A>1d where
       \<A>1d: "\<A>1 = to_st (decomp_rm\<^sub>e\<^sub>s\<^sub>t \<A>1d)" "(\<S>, \<A>\<^sub>d) \<Rightarrow>\<^sup>\<bullet>\<^sub>c\<^sup>* (\<S>1, \<A>1d)" "sem\<^sub>e\<^sub>s\<^sub>t_c {} \<I> \<A>1d"
     using step.IH by moura
 
   show ?case using step.hyps(2)
   proof (induction rule: pts_symbolic_induct)
     case Nil
     hence "(\<S>, \<A>\<^sub>d) \<Rightarrow>\<^sup>\<bullet>\<^sub>c\<^sup>* (\<S>2, \<A>1d)" using \<A>1d pts_symbolic_c.Nil[OF Nil.hyps(1), of \<A>1d] by simp
     thus ?case using \<A>1d Nil by auto
   next
     case (Send t S)
     hence "sem\<^sub>e\<^sub>s\<^sub>t_c {} \<I> (\<A>1d@[Step (receive\<langle>t\<rangle>\<^sub>s\<^sub>t)])" using sem\<^sub>e\<^sub>s\<^sub>t_c.Receive[OF \<A>1d(3)] by simp
     moreover have "(\<S>1, \<A>1d) \<Rightarrow>\<^sup>\<bullet>\<^sub>c (\<S>2, \<A>1d@[Step (receive\<langle>t\<rangle>\<^sub>s\<^sub>t)])"
       using Send.hyps(2) pts_symbolic_c.Send[OF Send.hyps(1), of \<A>1d] by simp
     moreover have "to_st (decomp_rm\<^sub>e\<^sub>s\<^sub>t (\<A>1d@[Step (receive\<langle>t\<rangle>\<^sub>s\<^sub>t)])) = \<A>2"
-      using Send.hyps(3) decomp_rm\<^sub>e\<^sub>s\<^sub>t_append \<A>1d(1) by (simp add: to_st_append) 
-    ultimately show ?case using \<A>1d(2) by auto      
+      using Send.hyps(3) decomp_rm\<^sub>e\<^sub>s\<^sub>t_append \<A>1d(1) by (simp add: to_st_append)
+    ultimately show ?case using \<A>1d(2) by auto
   next
     case (Equality a t t' S)
     hence "t \<cdot> \<I> = t' \<cdot> \<I>"
       using step.prems sem\<^sub>e\<^sub>s\<^sub>t_d_eq_sem_st[of "{}" \<I> "to_est \<A>2"]
             to_st_append to_est_append to_st_to_est_inv
       by auto
     hence "sem\<^sub>e\<^sub>s\<^sub>t_c {} \<I> (\<A>1d@[Step (\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t)])" using sem\<^sub>e\<^sub>s\<^sub>t_c.Equality[OF \<A>1d(3)] by simp
     moreover have "(\<S>1, \<A>1d) \<Rightarrow>\<^sup>\<bullet>\<^sub>c (\<S>2, \<A>1d@[Step (\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t)])"
       using Equality.hyps(2) pts_symbolic_c.Equality[OF Equality.hyps(1), of \<A>1d] by simp
     moreover have "to_st (decomp_rm\<^sub>e\<^sub>s\<^sub>t (\<A>1d@[Step (\<langle>a: t \<doteq> t'\<rangle>\<^sub>s\<^sub>t)])) = \<A>2"
-      using Equality.hyps(3) decomp_rm\<^sub>e\<^sub>s\<^sub>t_append \<A>1d(1) by (simp add: to_st_append) 
+      using Equality.hyps(3) decomp_rm\<^sub>e\<^sub>s\<^sub>t_append \<A>1d(1) by (simp add: to_st_append)
     ultimately show ?case using \<A>1d(2) by auto
   next
     case (Inequality X F S)
     hence "ineq_model \<I> X F"
       using step.prems sem\<^sub>e\<^sub>s\<^sub>t_d_eq_sem_st[of "{}" \<I> "to_est \<A>2"]
             to_st_append to_est_append to_st_to_est_inv
       by auto
     hence "sem\<^sub>e\<^sub>s\<^sub>t_c {} \<I> (\<A>1d@[Step (\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t)])" using sem\<^sub>e\<^sub>s\<^sub>t_c.Inequality[OF \<A>1d(3)] by simp
     moreover have "(\<S>1, \<A>1d) \<Rightarrow>\<^sup>\<bullet>\<^sub>c (\<S>2, \<A>1d@[Step (\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t)])"
       using Inequality.hyps(2) pts_symbolic_c.Inequality[OF Inequality.hyps(1), of \<A>1d] by simp
     moreover have "to_st (decomp_rm\<^sub>e\<^sub>s\<^sub>t (\<A>1d@[Step (\<forall>X\<langle>\<or>\<noteq>: F\<rangle>\<^sub>s\<^sub>t)])) = \<A>2"
-      using Inequality.hyps(3) decomp_rm\<^sub>e\<^sub>s\<^sub>t_append \<A>1d(1) by (simp add: to_st_append) 
+      using Inequality.hyps(3) decomp_rm\<^sub>e\<^sub>s\<^sub>t_append \<A>1d(1) by (simp add: to_st_append)
     ultimately show ?case using \<A>1d(2) by auto
   next
     case (Receive t S)
     hence "ik\<^sub>s\<^sub>t \<A>1 \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> t \<cdot> \<I>"
       using step.prems sem\<^sub>e\<^sub>s\<^sub>t_d_eq_sem_st[of "{}" \<I> "to_est \<A>2"]
             strand_sem_split(4)[of "{}" \<A>1 "[send\<langle>t\<rangle>\<^sub>s\<^sub>t]" \<I>]
             to_st_append to_est_append to_st_to_est_inv
       by auto
     moreover have "ik\<^sub>s\<^sub>t \<A>1 \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<subseteq> ik\<^sub>e\<^sub>s\<^sub>t \<A>1d \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I>" using \<A>1d(1) decomp_rm\<^sub>e\<^sub>s\<^sub>t_ik_subset by auto
     ultimately have *: "ik\<^sub>e\<^sub>s\<^sub>t \<A>1d \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile> t \<cdot> \<I>" using ideduct_mono by auto
 
     have "wf\<^sub>s\<^sub>t\<^sub>s' \<S> \<A>\<^sub>d" by (rule wf\<^sub>s\<^sub>t\<^sub>s'_decomp_rm[OF wa assms(4)])
     hence **: "wf\<^sub>e\<^sub>s\<^sub>t {} \<A>1d" by (rule pts_symbolic_c_preserves_wf_is[OF \<A>1d(2) _ assms(5)])
 
     have "Ana_invar_subst (\<Union>(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t`\<S>1) \<union> (ik\<^sub>e\<^sub>s\<^sub>t \<A>1d) \<union>
                            (\<Union>(assignment_rhs\<^sub>s\<^sub>t`\<S>1) \<union> (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>1d)))"
       using tar \<A>1d(2) pts_symbolic_c_preserves_Ana_invar_subst by metis
     hence "Ana_invar_subst (ik\<^sub>e\<^sub>s\<^sub>t \<A>1d)" "Ana_invar_subst (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>1d)"
       using Ana_invar_subst_subset by blast+
     moreover have "well_analyzed \<A>1d"
       using pts_symbolic_c_preserves_well_analyzed[OF \<A>1d(2) wa] by metis
     ultimately obtain D where D:
         "D \<in> decomps\<^sub>e\<^sub>s\<^sub>t (ik\<^sub>e\<^sub>s\<^sub>t \<A>1d) (assignment_rhs\<^sub>e\<^sub>s\<^sub>t \<A>1d) \<I>"
         "ik\<^sub>e\<^sub>s\<^sub>t (\<A>1d@D) \<cdot>\<^sub>s\<^sub>e\<^sub>t \<I> \<turnstile>\<^sub>c t \<cdot> \<I>"
       using decomps\<^sub>e\<^sub>s\<^sub>t_exist_subst[OF * \<A>1d(3) ** assms(8)] unfolding Ana_invar_subst_def by auto
-    
+
     have "(\<S>, \<A>\<^sub>d) \<Rightarrow>\<^sup>\<bullet>\<^sub>c\<^sup>* (\<S>1, \<A>1d@D)" using \<A>1d(2) decomps\<^sub>e\<^sub>s\<^sub>t_pts_symbolic_c[OF D(1), of \<S>1] by auto
     hence "(\<S>, \<A>\<^sub>d) \<Rightarrow>\<^sup>\<bullet>\<^sub>c\<^sup>* (\<S>2, \<A>1d@D@[Step (send\<langle>t\<rangle>\<^sub>s\<^sub>t)])"
       using Receive(2) pts_symbolic_c.Receive[OF Receive.hyps(1), of "\<A>1d@D"] by auto
     moreover have "\<A>2 = to_st (decomp_rm\<^sub>e\<^sub>s\<^sub>t (\<A>1d@D@[Step (send\<langle>t\<rangle>\<^sub>s\<^sub>t)]))"
       using Receive.hyps(3) \<A>1d(1) decomps\<^sub>e\<^sub>s\<^sub>t_decomp_rm\<^sub>e\<^sub>s\<^sub>t_empty[OF D(1)]
             decomp_rm\<^sub>e\<^sub>s\<^sub>t_append to_st_append
       by auto
     moreover have "sem\<^sub>e\<^sub>s\<^sub>t_c {} \<I> (\<A>1d@D@[Step (send\<langle>t\<rangle>\<^sub>s\<^sub>t)])"
       using D(2) sem\<^sub>e\<^sub>s\<^sub>t_c.Send[OF sem\<^sub>e\<^sub>s\<^sub>t_c_decomps\<^sub>e\<^sub>s\<^sub>t_append[OF \<A>1d(3) D(1)]] by simp
     ultimately show ?case by auto
   qed
 qed
 
 private lemma pts_symbolic_c_to_pts_symbolic:
   assumes "(\<S>,\<A>) \<Rightarrow>\<^sup>\<bullet>\<^sub>c\<^sup>* (\<S>',\<A>')" "sem\<^sub>e\<^sub>s\<^sub>t_c {} \<I> \<A>'"
   shows "(\<S>,to_st (decomp_rm\<^sub>e\<^sub>s\<^sub>t \<A>)) \<Rightarrow>\<^sup>\<bullet>\<^sup>* (\<S>',to_st (decomp_rm\<^sub>e\<^sub>s\<^sub>t \<A>'))"
         "sem\<^sub>e\<^sub>s\<^sub>t_d {} \<I> (decomp_rm\<^sub>e\<^sub>s\<^sub>t \<A>')"
 proof -
   show "(\<S>,to_st (decomp_rm\<^sub>e\<^sub>s\<^sub>t \<A>)) \<Rightarrow>\<^sup>\<bullet>\<^sup>* (\<S>',to_st (decomp_rm\<^sub>e\<^sub>s\<^sub>t \<A>'))" using assms(1)
   proof (induction rule: rtranclp_induct2)
     case (step \<S>1 \<A>1 \<S>2 \<A>2) show ?case using step.hyps(2,1) step.IH
     proof (induction rule: pts_symbolic_c_induct)
       case Nil thus ?case
         using pts_symbolic.Nil[OF Nil.hyps(1), of "to_st (decomp_rm\<^sub>e\<^sub>s\<^sub>t \<A>1)"] by simp
     next
       case (Send t S) thus ?case
         using pts_symbolic.Send[OF Send.hyps(1), of "to_st (decomp_rm\<^sub>e\<^sub>s\<^sub>t \<A>1)"]
         by (simp add: decomp_rm\<^sub>e\<^sub>s\<^sub>t_append to_st_append)
     next
       case (Receive t S) thus ?case
-        using pts_symbolic.Receive[OF Receive.hyps(1), of "to_st (decomp_rm\<^sub>e\<^sub>s\<^sub>t \<A>1)"] 
+        using pts_symbolic.Receive[OF Receive.hyps(1), of "to_st (decomp_rm\<^sub>e\<^sub>s\<^sub>t \<A>1)"]
         by (simp add: decomp_rm\<^sub>e\<^sub>s\<^sub>t_append to_st_append)
     next
       case (Equality a t t' S) thus ?case
-        using pts_symbolic.Equality[OF Equality.hyps(1), of "to_st (decomp_rm\<^sub>e\<^sub>s\<^sub>t \<A>1)"] 
+        using pts_symbolic.Equality[OF Equality.hyps(1), of "to_st (decomp_rm\<^sub>e\<^sub>s\<^sub>t \<A>1)"]
         by (simp add: decomp_rm\<^sub>e\<^sub>s\<^sub>t_append to_st_append)
     next
       case (Inequality t t' S) thus ?case
-        using pts_symbolic.Inequality[OF Inequality.hyps(1), of "to_st (decomp_rm\<^sub>e\<^sub>s\<^sub>t \<A>1)"] 
+        using pts_symbolic.Inequality[OF Inequality.hyps(1), of "to_st (decomp_rm\<^sub>e\<^sub>s\<^sub>t \<A>1)"]
         by (simp add: decomp_rm\<^sub>e\<^sub>s\<^sub>t_append to_st_append)
     next
       case (Decompose t) thus ?case using decomp_rm\<^sub>e\<^sub>s\<^sub>t_append by simp
     qed
   qed simp
 qed (rule sem\<^sub>e\<^sub>s\<^sub>t_d_decomp_rm\<^sub>e\<^sub>s\<^sub>t_if_sem\<^sub>e\<^sub>s\<^sub>t_c[OF assms(2)])
 
 private lemma pts_symbolic_to_pts_symbolic_c_from_initial:
   assumes "(\<S>\<^sub>0,[]) \<Rightarrow>\<^sup>\<bullet>\<^sup>* (\<S>,\<A>)" "\<I> \<Turnstile> \<langle>\<A>\<rangle>" "wf\<^sub>s\<^sub>t\<^sub>s' \<S>\<^sub>0 []"
   and "Ana_invar_subst (\<Union>(ik\<^sub>s\<^sub>t ` dual\<^sub>s\<^sub>t ` \<S>\<^sub>0) \<union> \<Union>(assignment_rhs\<^sub>s\<^sub>t ` \<S>\<^sub>0))" "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>"
   shows "\<exists>\<A>\<^sub>d. \<A> = to_st (decomp_rm\<^sub>e\<^sub>s\<^sub>t \<A>\<^sub>d) \<and> (\<S>\<^sub>0,[]) \<Rightarrow>\<^sup>\<bullet>\<^sub>c\<^sup>* (\<S>,\<A>\<^sub>d) \<and> (\<I> \<Turnstile>\<^sub>c \<langle>to_st \<A>\<^sub>d\<rangle>)"
 using assms pts_symbolic_to_pts_symbolic_c[of \<S>\<^sub>0 "[]" \<S> \<A> \<I>]
       sem\<^sub>e\<^sub>s\<^sub>t_c_eq_sem_st[of "{}" \<I>] sem\<^sub>e\<^sub>s\<^sub>t_d_eq_sem_st[of "{}" \<I>]
       to_st_to_est_inv[of \<A>] strand_sem_eq_defs
 by (auto simp add: constr_sem_c_def constr_sem_d_def simp del: subst_range.simps)
 
 private lemma pts_symbolic_c_to_pts_symbolic_from_initial:
   assumes "(\<S>\<^sub>0,[]) \<Rightarrow>\<^sup>\<bullet>\<^sub>c\<^sup>* (\<S>,\<A>)" "\<I> \<Turnstile>\<^sub>c \<langle>to_st \<A>\<rangle>"
   shows "(\<S>\<^sub>0,[]) \<Rightarrow>\<^sup>\<bullet>\<^sup>* (\<S>,to_st (decomp_rm\<^sub>e\<^sub>s\<^sub>t \<A>))" "\<I> \<Turnstile> \<langle>to_st (decomp_rm\<^sub>e\<^sub>s\<^sub>t \<A>)\<rangle>"
 using assms pts_symbolic_c_to_pts_symbolic[of \<S>\<^sub>0 "[]" \<S> \<A> \<I>]
       sem\<^sub>e\<^sub>s\<^sub>t_c_eq_sem_st[of "{}" \<I>] sem\<^sub>e\<^sub>s\<^sub>t_d_eq_sem_st[of "{}" \<I>] strand_sem_eq_defs
 by (auto simp add: constr_sem_c_def constr_sem_d_def)
 
 private lemma to_st_trms_wf:
   assumes "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>e\<^sub>s\<^sub>t A)"
   shows "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t (to_st A))"
 using assms
 proof (induction A)
   case (Cons x A)
   hence IH: "\<forall>t \<in> trms\<^sub>s\<^sub>t (to_st A). wf\<^sub>t\<^sub>r\<^sub>m t" by auto
   with Cons show ?case
   proof (cases x)
     case (Decomp t)
     hence "wf\<^sub>t\<^sub>r\<^sub>m t" using Cons.prems by auto
     obtain K T where Ana_t: "Ana t = (K,T)" by moura
     hence "trms\<^sub>s\<^sub>t (decomp t) \<subseteq> {t} \<union> set K \<union> set T" using decomp_set_unfold[OF Ana_t] by force
     moreover have "\<forall>t \<in> set T. wf\<^sub>t\<^sub>r\<^sub>m t" using Ana_subterm[OF Ana_t] \<open>wf\<^sub>t\<^sub>r\<^sub>m t\<close> wf_trm_subterm by auto
     ultimately have "\<forall>t \<in> trms\<^sub>s\<^sub>t (decomp t). wf\<^sub>t\<^sub>r\<^sub>m t" using Ana_keys_wf'[OF Ana_t] \<open>wf\<^sub>t\<^sub>r\<^sub>m t\<close> by auto
     thus ?thesis using IH Decomp by auto
   qed auto
 qed simp
 
 private lemma to_st_trms_SMP_subset: "trms\<^sub>s\<^sub>t (to_st A) \<subseteq> SMP (trms\<^sub>e\<^sub>s\<^sub>t A)"
 proof
   fix t assume "t \<in> trms\<^sub>s\<^sub>t (to_st A)" thus "t \<in> SMP (trms\<^sub>e\<^sub>s\<^sub>t A)"
   proof (induction A)
     case (Cons x A)
     hence *: "t \<in> trms\<^sub>s\<^sub>t (to_st [x]) \<union> trms\<^sub>s\<^sub>t (to_st A)" using to_st_append[of "[x]" A] by auto
     have **: "trms\<^sub>s\<^sub>t (to_st A) \<subseteq> trms\<^sub>s\<^sub>t (to_st (x#A))" "trms\<^sub>e\<^sub>s\<^sub>t A \<subseteq> trms\<^sub>e\<^sub>s\<^sub>t (x#A)"
       using to_st_append[of "[x]" A] by auto
     show ?case
     proof (cases "t \<in> trms\<^sub>s\<^sub>t (to_st A)")
       case True thus ?thesis using Cons.IH SMP_mono[OF **(2)] by auto
     next
       case False
       hence ***: "t \<in> trms\<^sub>s\<^sub>t (to_st [x])" using * by auto
       thus ?thesis
       proof (cases x)
         case (Decomp t')
         hence ****: "t \<in> trms\<^sub>s\<^sub>t (decomp t')" "t' \<in> trms\<^sub>e\<^sub>s\<^sub>t (x#A)" using *** by auto
         obtain K T where Ana_t': "Ana t' = (K,T)" by moura
         hence "t \<in> {t'} \<union> set K \<union> set T" using decomp_set_unfold[OF Ana_t'] ****(1) by force
         moreover
         { assume "t = t'" hence ?thesis using SMP.MP[OF ****(2)] by simp }
         moreover
         { assume "t \<in> set K" hence ?thesis using SMP.Ana[OF SMP.MP[OF ****(2)] Ana_t'] by auto }
         moreover
         { assume "t \<in> set T" "t \<noteq> t'"
           hence "t \<sqsubset> t'" using Ana_subterm[OF Ana_t'] by blast
           hence ?thesis using SMP.Subterm[OF SMP.MP[OF ****(2)]] by auto
-        } 
+        }
         ultimately show ?thesis using Decomp by auto
       qed auto
     qed
   qed simp
 qed
 
 private lemma to_st_trms_tfr\<^sub>s\<^sub>e\<^sub>t:
   assumes "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>e\<^sub>s\<^sub>t A)"
   shows "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t (to_st A))"
 proof -
   have *: "trms\<^sub>s\<^sub>t (to_st A) \<subseteq> SMP (trms\<^sub>e\<^sub>s\<^sub>t A)"
     using to_st_trms_wf to_st_trms_SMP_subset assms unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def by auto
   have "trms\<^sub>s\<^sub>t (to_st A) = trms\<^sub>s\<^sub>t (to_st A) \<union> trms\<^sub>e\<^sub>s\<^sub>t A" by (blast dest!: trms\<^sub>e\<^sub>s\<^sub>tD)
   hence "SMP (trms\<^sub>e\<^sub>s\<^sub>t A) = SMP (trms\<^sub>s\<^sub>t (to_st A))" using SMP_subset_union_eq[OF *] by auto
   thus ?thesis using * assms unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def by presburger
 qed
 
 theorem wt_attack_if_tfr_attack_pts:
   assumes "wf\<^sub>s\<^sub>t\<^sub>s \<S>\<^sub>0" "tfr\<^sub>s\<^sub>e\<^sub>t (\<Union>(trms\<^sub>s\<^sub>t ` \<S>\<^sub>0))" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (\<Union>(trms\<^sub>s\<^sub>t ` \<S>\<^sub>0))" "\<forall>S \<in> \<S>\<^sub>0. list_all tfr\<^sub>s\<^sub>t\<^sub>p S"
   and "Ana_invar_subst (\<Union>(ik\<^sub>s\<^sub>t ` dual\<^sub>s\<^sub>t ` \<S>\<^sub>0) \<union> \<Union>(assignment_rhs\<^sub>s\<^sub>t ` \<S>\<^sub>0))"
   and "(\<S>\<^sub>0,[]) \<Rightarrow>\<^sup>\<bullet>\<^sup>* (\<S>,\<A>)" "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>" "\<I> \<Turnstile> \<langle>\<A>, Var\<rangle>"
   shows "\<exists>\<I>\<^sub>\<tau>. interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>\<^sub>\<tau> \<and> (\<I>\<^sub>\<tau> \<Turnstile> \<langle>\<A>, Var\<rangle>) \<and> wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>\<^sub>\<tau> \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<I>\<^sub>\<tau>)"
 proof -
   have "(\<Union>(trms\<^sub>s\<^sub>t ` \<S>\<^sub>0)) \<union> (trms\<^sub>e\<^sub>s\<^sub>t []) = \<Union>(trms\<^sub>s\<^sub>t ` \<S>\<^sub>0)" "to_st [] = []" "list_all tfr\<^sub>s\<^sub>t\<^sub>p []"
     using assms by simp_all
   hence *: "tfr\<^sub>s\<^sub>e\<^sub>t ((\<Union>(trms\<^sub>s\<^sub>t ` \<S>\<^sub>0)) \<union> (trms\<^sub>e\<^sub>s\<^sub>t []))"
            "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s ((\<Union>(trms\<^sub>s\<^sub>t ` \<S>\<^sub>0)) \<union> (trms\<^sub>e\<^sub>s\<^sub>t []))"
            "wf\<^sub>s\<^sub>t\<^sub>s' \<S>\<^sub>0 []" "\<forall>S \<in> \<S>\<^sub>0 \<union> {to_st []}. list_all tfr\<^sub>s\<^sub>t\<^sub>p S"
     using assms wf\<^sub>s\<^sub>t\<^sub>s_wf\<^sub>s\<^sub>t\<^sub>s' by (metis, metis, metis, simp)
 
   obtain \<A>\<^sub>d where \<A>\<^sub>d: "\<A> = to_st (decomp_rm\<^sub>e\<^sub>s\<^sub>t \<A>\<^sub>d)" "(\<S>\<^sub>0,[]) \<Rightarrow>\<^sup>\<bullet>\<^sub>c\<^sup>* (\<S>,\<A>\<^sub>d)" "\<I> \<Turnstile>\<^sub>c \<langle>to_st \<A>\<^sub>d\<rangle>"
     using pts_symbolic_to_pts_symbolic_c_from_initial assms *(3) by metis
   hence "tfr\<^sub>s\<^sub>e\<^sub>t (\<Union>(trms\<^sub>s\<^sub>t ` \<S>) \<union> (trms\<^sub>e\<^sub>s\<^sub>t \<A>\<^sub>d))" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (\<Union>(trms\<^sub>s\<^sub>t ` \<S>) \<union> (trms\<^sub>e\<^sub>s\<^sub>t \<A>\<^sub>d))"
     using pts_symbolic_c_preserves_tfr\<^sub>s\<^sub>e\<^sub>t[OF _ *(1,2)] by blast+
   hence "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>e\<^sub>s\<^sub>t \<A>\<^sub>d)" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>e\<^sub>s\<^sub>t \<A>\<^sub>d)"
     unfolding tfr\<^sub>s\<^sub>e\<^sub>t_def by (metis DiffE DiffI SMP_union UnCI, metis UnCI)
   hence "tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t (to_st \<A>\<^sub>d))" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t (to_st \<A>\<^sub>d))"
     by (metis to_st_trms_tfr\<^sub>s\<^sub>e\<^sub>t, metis to_st_trms_wf)
   moreover have "wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r (to_st \<A>\<^sub>d) Var"
   proof -
     have "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t Var" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range Var)" "subst_domain Var \<inter> vars\<^sub>e\<^sub>s\<^sub>t \<A>\<^sub>d = {}"
          "range_vars Var \<inter> bvars\<^sub>e\<^sub>s\<^sub>t \<A>\<^sub>d = {}"
       by (simp_all add: range_vars_alt_def)
     moreover have "wf\<^sub>e\<^sub>s\<^sub>t {} \<A>\<^sub>d"
       using pts_symbolic_c_preserves_wf_is[OF \<A>\<^sub>d(2) *(3), of "{}"]
       by auto
     moreover have "fv\<^sub>s\<^sub>t (to_st \<A>\<^sub>d) \<inter> bvars\<^sub>e\<^sub>s\<^sub>t \<A>\<^sub>d = {}"
       using pts_symbolic_c_preserves_constr_disj_vars[OF \<A>\<^sub>d(2)] assms(1) wf\<^sub>s\<^sub>t\<^sub>s_wf\<^sub>s\<^sub>t\<^sub>s'
       by fastforce
     ultimately show ?thesis unfolding wf\<^sub>c\<^sub>o\<^sub>n\<^sub>s\<^sub>t\<^sub>r_def wf\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t_def by simp
   qed
   moreover have "list_all tfr\<^sub>s\<^sub>t\<^sub>p (to_st \<A>\<^sub>d)"
     using pts_symbolic_c_preserves_tfr\<^sub>s\<^sub>t\<^sub>p[OF \<A>\<^sub>d(2) *(4)] by blast
   moreover have "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t Var" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range Var)" by simp_all
   ultimately obtain \<I>\<^sub>\<tau> where \<I>\<^sub>\<tau>:
       "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>\<^sub>\<tau>" "\<I>\<^sub>\<tau> \<Turnstile>\<^sub>c \<langle>to_st \<A>\<^sub>d, Var\<rangle>" "wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>\<^sub>\<tau>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<I>\<^sub>\<tau>)"
     using wt_attack_if_tfr_attack[OF assms(7) \<A>\<^sub>d(3)]
           \<open>tfr\<^sub>s\<^sub>e\<^sub>t (trms\<^sub>s\<^sub>t (to_st \<A>\<^sub>d))\<close> \<open>list_all tfr\<^sub>s\<^sub>t\<^sub>p (to_st \<A>\<^sub>d)\<close>
     unfolding tfr\<^sub>s\<^sub>t_def by metis
   hence "\<I>\<^sub>\<tau> \<Turnstile> \<langle>\<A>, Var\<rangle>" using pts_symbolic_c_to_pts_symbolic_from_initial \<A>\<^sub>d by metis
   thus ?thesis using \<I>\<^sub>\<tau>(1,3,4) by metis
 qed
 
 
 subsubsection \<open>Corollary: The Typing Result on the Level of Constraints\<close>
 text \<open>There exists well-typed models of satisfiable type-flaw resistant constraints\<close>
 corollary wt_attack_if_tfr_attack_d:
   assumes "wf\<^sub>s\<^sub>t {} \<A>" "fv\<^sub>s\<^sub>t \<A> \<inter> bvars\<^sub>s\<^sub>t \<A> = {}" "tfr\<^sub>s\<^sub>t \<A>" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (trms\<^sub>s\<^sub>t \<A>)"
   and "Ana_invar_subst (ik\<^sub>s\<^sub>t \<A> \<union> assignment_rhs\<^sub>s\<^sub>t \<A>)"
   and "interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>" "\<I> \<Turnstile> \<langle>\<A>\<rangle>"
   shows "\<exists>\<I>\<^sub>\<tau>. interpretation\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>\<^sub>\<tau> \<and> (\<I>\<^sub>\<tau> \<Turnstile> \<langle>\<A>\<rangle>) \<and> wt\<^sub>s\<^sub>u\<^sub>b\<^sub>s\<^sub>t \<I>\<^sub>\<tau> \<and> wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (subst_range \<I>\<^sub>\<tau>)"
 proof -
   { fix S A have "({S},A) \<Rightarrow>\<^sup>\<bullet>\<^sup>* ({},A@dual\<^sub>s\<^sub>t S)"
     proof (induction S arbitrary: A)
       case Nil thus ?case using pts_symbolic.Nil[of "{[]}"] by auto
     next
       case (Cons x S)
       hence "({S}, A@dual\<^sub>s\<^sub>t [x]) \<Rightarrow>\<^sup>\<bullet>\<^sup>* ({}, A@dual\<^sub>s\<^sub>t (x#S))"
         by (metis dual\<^sub>s\<^sub>t_append List.append_assoc List.append_Nil List.append_Cons)
       moreover have "({x#S}, A) \<Rightarrow>\<^sup>\<bullet> ({S}, A@dual\<^sub>s\<^sub>t [x])"
         using pts_symbolic.Send[of _ S "{x#S}"] pts_symbolic.Receive[of _ S "{x#S}"]
               pts_symbolic.Equality[of _ _ _ S "{x#S}"] pts_symbolic.Inequality[of _ _ S "{x#S}"]
         by (cases x) auto
       ultimately show ?case by simp
     qed
   }
   hence 0: "({dual\<^sub>s\<^sub>t \<A>},[]) \<Rightarrow>\<^sup>\<bullet>\<^sup>* ({},\<A>)" using dual\<^sub>s\<^sub>t_self_inverse by (metis List.append_Nil)
 
   have "fv\<^sub>s\<^sub>t (dual\<^sub>s\<^sub>t \<A>) \<inter> bvars\<^sub>s\<^sub>t (dual\<^sub>s\<^sub>t \<A>) = {}" using assms(2) dual\<^sub>s\<^sub>t_fv dual\<^sub>s\<^sub>t_bvars by metis+
   hence 1: "wf\<^sub>s\<^sub>t\<^sub>s {dual\<^sub>s\<^sub>t \<A>}" using assms(1,2) dual\<^sub>s\<^sub>t_self_inverse[of \<A>] unfolding wf\<^sub>s\<^sub>t\<^sub>s_def by auto
-  
+
   have "\<Union>(trms\<^sub>s\<^sub>t ` {\<A>}) = trms\<^sub>s\<^sub>t \<A>" "\<Union>(trms\<^sub>s\<^sub>t ` {dual\<^sub>s\<^sub>t \<A>}) = trms\<^sub>s\<^sub>t (dual\<^sub>s\<^sub>t \<A>)" by auto
   hence "tfr\<^sub>s\<^sub>e\<^sub>t (\<Union>(trms\<^sub>s\<^sub>t ` {\<A>}))" "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (\<Union>(trms\<^sub>s\<^sub>t ` {\<A>}))"
         "(\<Union>(trms\<^sub>s\<^sub>t ` {\<A>})) = \<Union>(trms\<^sub>s\<^sub>t ` {dual\<^sub>s\<^sub>t \<A>})"
     using assms(3,4) unfolding tfr\<^sub>s\<^sub>t_def
     by (metis, metis, metis dual\<^sub>s\<^sub>t_trms_eq)
   hence 2: "tfr\<^sub>s\<^sub>e\<^sub>t (\<Union>(trms\<^sub>s\<^sub>t ` {dual\<^sub>s\<^sub>t \<A>}))" and 3: "wf\<^sub>t\<^sub>r\<^sub>m\<^sub>s (\<Union>(trms\<^sub>s\<^sub>t ` {dual\<^sub>s\<^sub>t \<A>}))" by metis+
 
   have 4: "\<forall>S \<in> {dual\<^sub>s\<^sub>t \<A>}. list_all tfr\<^sub>s\<^sub>t\<^sub>p S"
     using dual\<^sub>s\<^sub>t_tfr\<^sub>s\<^sub>t\<^sub>p assms(3) unfolding tfr\<^sub>s\<^sub>t_def by blast
 
   have "assignment_rhs\<^sub>s\<^sub>t \<A> = assignment_rhs\<^sub>s\<^sub>t (dual\<^sub>s\<^sub>t \<A>)"
     by (induct \<A> rule: assignment_rhs\<^sub>s\<^sub>t.induct) auto
   hence 5: "Ana_invar_subst (\<Union>(ik\<^sub>s\<^sub>t`dual\<^sub>s\<^sub>t`{dual\<^sub>s\<^sub>t \<A>}) \<union> \<Union>(assignment_rhs\<^sub>s\<^sub>t`{dual\<^sub>s\<^sub>t \<A>}))"
     using assms(5) dual\<^sub>s\<^sub>t_self_inverse[of \<A>] by auto
 
   show ?thesis by (rule wt_attack_if_tfr_attack_pts[OF 1 2 3 4 5 0 assms(6,7)])
 qed
 
 end
 
 end
 
 end